{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Crypto.PubKey.ECDSA
( EllipticCurveECDSA (..)
, PublicKey
, encodePublic
, decodePublic
, toPublic
, PrivateKey
, encodePrivate
, decodePrivate
, Signature(..)
, signatureFromIntegers
, signatureToIntegers
, 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)
data Signature curve = Signature
{ forall curve. Signature curve -> Scalar curve
sign_r :: Scalar curve
, forall curve. Signature curve -> Scalar curve
sign_s :: Scalar curve
}
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) = forall a. NFData a => a -> ()
rnf Scalar curve
r seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Scalar curve
s seq :: forall a b. a -> b -> b
`seq` ()
type PublicKey curve = Point curve
type PrivateKey curve = Scalar curve
class EllipticCurveBasepointArith curve => EllipticCurveECDSA curve where
scalarIsValid :: proxy curve -> Scalar curve -> Bool
scalarIsZero :: proxy curve -> Scalar curve -> Bool
scalarIsZero proxy curve
prx Scalar curve
s = Scalar curve
s forall a. Eq a => a -> a -> Bool
== forall a. CryptoFailable a -> a
throwCryptoError (forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Integer -> CryptoFailable (Scalar curve)
scalarFromInteger proxy curve
prx Integer
0)
scalarInv :: proxy curve -> Scalar curve -> Maybe (Scalar curve)
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 Curve_P256R1
s)
Bool -> Bool -> Bool
&& Scalar -> Scalar -> Ordering
P256.scalarCmp Scalar Curve_P256R1
s Scalar
P256.scalarN 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
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 Curve_P256R1
s
in if Scalar -> Bool
P256.scalarIsZero Scalar
inv then forall a. Maybe a
Nothing else 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
P256.pointX
instance EllipticCurveECDSA Curve_P384R1 where
scalarIsValid :: forall (proxy :: * -> *).
proxy Curve_P384R1 -> Scalar Curve_P384R1 -> Bool
scalarIsValid proxy Curve_P384R1
_ = forall c (proxy :: * -> *). Curve c => proxy c -> Scalar c -> Bool
ecScalarIsValid (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
_ = 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
_ = forall c (proxy :: * -> *).
Curve c =>
proxy c -> Scalar c -> Maybe (Scalar c)
ecScalarInv (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
_ = forall c (proxy :: * -> *).
Curve c =>
proxy c -> Point c -> Maybe (Scalar c)
ecPointX (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
_ = forall c (proxy :: * -> *). Curve c => proxy c -> Scalar c -> Bool
ecScalarIsValid (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
_ = 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
_ = forall c (proxy :: * -> *).
Curve c =>
proxy c -> Scalar c -> Maybe (Scalar c)
ecScalarInv (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
_ = forall c (proxy :: * -> *).
Curve c =>
proxy c -> Point c -> Maybe (Scalar c)
ecPointX (forall {k} (t :: k). Proxy t
Proxy :: Proxy Simple.SEC_p521r1)
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) =
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall curve. Scalar curve -> Scalar curve -> Signature curve
Signature (forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Integer -> CryptoFailable (Scalar curve)
scalarFromInteger proxy curve
prx Integer
r) (forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Integer -> CryptoFailable (Scalar curve)
scalarFromInteger proxy curve
prx Integer
s)
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 =
(forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Integer
scalarToInteger proxy curve
prx forall a b. (a -> b) -> a -> b
$ forall curve. Signature curve -> Scalar curve
sign_r Signature curve
sig, forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Integer
scalarToInteger proxy curve
prx forall a b. (a -> b) -> a -> b
$ forall curve. Signature curve -> Scalar curve
sign_s Signature curve
sig)
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 = forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> Point curve -> bs
encodePoint
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 = forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Point curve)
decodePoint
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 = forall curve bs (proxy :: * -> *).
(EllipticCurveBasepointArith curve, ByteArray bs) =>
proxy curve -> Scalar curve -> bs
encodeScalar
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 = forall curve bs (proxy :: * -> *).
(EllipticCurveBasepointArith curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
decodeScalar
toPublic :: EllipticCurveECDSA curve
=> proxy curve -> PrivateKey curve -> PublicKey curve
toPublic :: forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> PrivateKey curve -> PublicKey curve
toPublic = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Point curve
pointBaseSmul
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 = 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 = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Point curve
pointBaseSmul proxy curve
prx Scalar curve
k
Scalar curve
r <- forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Point curve -> Maybe (Scalar curve)
pointX proxy curve
prx Point curve
point
Scalar curve
kInv <- forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Scalar curve -> Maybe (Scalar curve)
scalarInv proxy curve
prx Scalar curve
k
let s :: Scalar curve
s = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
scalarMul proxy curve
prx Scalar curve
kInv (forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
scalarAdd proxy curve
prx Scalar curve
z (forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
scalarMul proxy curve
prx Scalar curve
r Scalar curve
d))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Scalar curve -> Bool
scalarIsZero proxy curve
prx Scalar curve
r Bool -> Bool -> Bool
|| forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Scalar curve -> Bool
scalarIsZero proxy curve
prx Scalar curve
s) forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall curve. Scalar curve -> Scalar curve -> Signature curve
Signature Scalar curve
r Scalar curve
s
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 = 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 (forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith hash
hashAlg msg
msg)
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 <- forall curve (randomly :: * -> *) (proxy :: * -> *).
(EllipticCurve curve, MonadRandom randomly) =>
proxy curve -> randomly (Scalar curve)
curveGenerateScalar proxy curve
prx
case 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 -> 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return Signature curve
sig
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 = 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 (forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith hash
hashAlg msg
msg)
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 (forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Scalar curve -> Bool
scalarIsValid proxy curve
prx Scalar curve
r) = Bool
False
| Bool -> Bool
not (forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Scalar curve -> Bool
scalarIsValid proxy curve
prx Scalar curve
s) = Bool
False
| Bool
otherwise = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Scalar curve
r forall a. Eq a => a -> a -> Bool
==) forall a b. (a -> b) -> a -> b
$ do
Scalar curve
w <- forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Scalar curve -> Maybe (Scalar curve)
scalarInv proxy curve
prx Scalar curve
s
let z :: Scalar curve
z = 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 = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
scalarMul proxy curve
prx Scalar curve
z Scalar curve
w
u2 :: Scalar curve
u2 = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
scalarMul proxy curve
prx Scalar curve
r Scalar curve
w
x :: PublicKey curve
x = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve
-> Scalar curve -> Scalar curve -> Point curve -> Point curve
pointsSmulVarTime proxy curve
prx Scalar curve
u1 Scalar curve
u2 PublicKey curve
q
forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Point curve -> Maybe (Scalar curve)
pointX proxy curve
prx PublicKey curve
x
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 = 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 (forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith hash
hashAlg msg
msg)
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) = forall a. CryptoFailable a -> a
throwCryptoError forall a b. (a -> b) -> a -> b
$ forall curve bs (proxy :: * -> *).
(EllipticCurveBasepointArith curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
decodeScalar proxy curve
prx Block Word8
encoded
where m :: Int
m = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Int
curveOrderBits proxy curve
prx
d :: Int
d = Int
m forall a. Num a => a -> a -> a
- forall ba. ByteArrayAccess ba => ba -> Int
B.length Block Word8
digest forall a. Num a => a -> a -> a
* Int
8
(Int
n, Int
r) = Int
m forall a. Integral a => a -> a -> (a, a)
`divMod` Int
8
n' :: Int
n' = if Int
r forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. Enum a => a -> a
succ Int
n else Int
n
encoded :: Block Word8
encoded
| Int
d forall a. Ord a => a -> a -> Bool
> Int
0 = forall ba. ByteArray ba => Int -> ba
B.zero (Int
n' forall a. Num a => a -> a -> a
- forall ba. ByteArrayAccess ba => ba -> Int
B.length Block Word8
digest) forall bs. ByteArray bs => bs -> bs -> bs
`B.append` Block Word8
digest
| Int
d forall a. Eq a => a -> a -> Bool
== Int
0 = Block Word8
digest
| Int
r forall a. Eq a => a -> a -> Bool
== Int
0 = 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 = forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
n' forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst ->
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray Block Word8
bs 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 forall a. Ord a => a -> a -> Bool
>= Int
n' = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
b <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
i (forall a. Bits a => a -> Int -> a
unsafeShiftR Word8
b (Int
8 forall a. Num a => a -> a -> a
- Int
r) forall a. Bits a => a -> a -> a
.|. 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 (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 forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Integer
s forall a. Ord a => a -> a -> Bool
< Integer
n
where n :: Integer
n = forall curve. CurveParameters curve -> Integer
Simple.curveEccN forall a b. (a -> b) -> a -> b
$ forall curve (proxy :: * -> *).
Curve curve =>
proxy curve -> CurveParameters curve
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 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 forall a. Eq a => a -> a -> Bool
== Integer
0 = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall curve. Integer -> Scalar curve
Simple.Scalar Integer
i
where n :: Integer
n = forall curve. CurveParameters curve -> Integer
Simple.curveEccN forall a b. (a -> b) -> a -> b
$ forall curve (proxy :: * -> *).
Curve curve =>
proxy curve -> CurveParameters curve
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 = forall a. Maybe a
Nothing
ecPointX proxy c
prx (Simple.Point Integer
x Integer
_) = forall a. a -> Maybe a
Just (forall curve. Integer -> Scalar curve
Simple.Scalar forall a b. (a -> b) -> a -> b
$ Integer
x forall a. Integral a => a -> a -> a
`mod` Integer
n)
where n :: Integer
n = forall curve. CurveParameters curve -> Integer
Simple.curveEccN forall a b. (a -> b) -> a -> b
$ forall curve (proxy :: * -> *).
Curve curve =>
proxy curve -> CurveParameters curve
Simple.curveParameters proxy c
prx