{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Crypto.PubKey.EdDSA
( SecretKey
, PublicKey
, Signature
, EllipticCurveEdDSA(CurveDigestSize)
, publicKeySize
, secretKeySize
, signatureSize
, signature
, publicKey
, secretKey
, 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
newtype SecretKey curve = SecretKey ScrubbedBytes
deriving (Int -> SecretKey curve -> ShowS
forall curve. Int -> SecretKey curve -> ShowS
forall curve. [SecretKey curve] -> ShowS
forall curve. SecretKey curve -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecretKey curve] -> ShowS
$cshowList :: forall curve. [SecretKey curve] -> ShowS
show :: SecretKey curve -> String
$cshow :: forall curve. SecretKey curve -> String
showsPrec :: Int -> SecretKey curve -> ShowS
$cshowsPrec :: forall curve. Int -> SecretKey curve -> ShowS
Show,SecretKey curve -> SecretKey curve -> Bool
forall curve. SecretKey curve -> SecretKey curve -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecretKey curve -> SecretKey curve -> Bool
$c/= :: forall curve. SecretKey curve -> SecretKey curve -> Bool
== :: SecretKey curve -> SecretKey curve -> Bool
$c== :: forall curve. SecretKey curve -> SecretKey curve -> Bool
Eq,SecretKey curve -> Int
forall curve. SecretKey curve -> Int
forall p. SecretKey curve -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall curve p. SecretKey curve -> Ptr p -> IO ()
forall p a. SecretKey curve -> (Ptr p -> IO a) -> IO a
forall curve p a. SecretKey curve -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: forall p. SecretKey curve -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall curve p. SecretKey curve -> Ptr p -> IO ()
withByteArray :: forall p a. SecretKey curve -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall curve p a. SecretKey curve -> (Ptr p -> IO a) -> IO a
length :: SecretKey curve -> Int
$clength :: forall curve. SecretKey curve -> Int
ByteArrayAccess,SecretKey curve -> ()
forall curve. SecretKey curve -> ()
forall a. (a -> ()) -> NFData a
rnf :: SecretKey curve -> ()
$crnf :: forall curve. SecretKey curve -> ()
NFData)
newtype PublicKey curve hash = PublicKey Bytes
deriving (Int -> PublicKey curve hash -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall curve hash. Int -> PublicKey curve hash -> ShowS
forall curve hash. [PublicKey curve hash] -> ShowS
forall curve hash. PublicKey curve hash -> String
showList :: [PublicKey curve hash] -> ShowS
$cshowList :: forall curve hash. [PublicKey curve hash] -> ShowS
show :: PublicKey curve hash -> String
$cshow :: forall curve hash. PublicKey curve hash -> String
showsPrec :: Int -> PublicKey curve hash -> ShowS
$cshowsPrec :: forall curve hash. Int -> PublicKey curve hash -> ShowS
Show,PublicKey curve hash -> PublicKey curve hash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall curve hash.
PublicKey curve hash -> PublicKey curve hash -> Bool
/= :: PublicKey curve hash -> PublicKey curve hash -> Bool
$c/= :: forall curve hash.
PublicKey curve hash -> PublicKey curve hash -> Bool
== :: PublicKey curve hash -> PublicKey curve hash -> Bool
$c== :: forall curve hash.
PublicKey curve hash -> PublicKey curve hash -> Bool
Eq,PublicKey curve hash -> Int
forall p. PublicKey curve hash -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall curve hash. PublicKey curve hash -> Int
forall p a. PublicKey curve hash -> (Ptr p -> IO a) -> IO a
forall curve hash p. PublicKey curve hash -> Ptr p -> IO ()
forall curve hash p a.
PublicKey curve hash -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: forall p. PublicKey curve hash -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall curve hash p. PublicKey curve hash -> Ptr p -> IO ()
withByteArray :: forall p a. PublicKey curve hash -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall curve hash p a.
PublicKey curve hash -> (Ptr p -> IO a) -> IO a
length :: PublicKey curve hash -> Int
$clength :: forall curve hash. PublicKey curve hash -> Int
ByteArrayAccess,PublicKey curve hash -> ()
forall a. (a -> ()) -> NFData a
forall curve hash. PublicKey curve hash -> ()
rnf :: PublicKey curve hash -> ()
$crnf :: forall curve hash. PublicKey curve hash -> ()
NFData)
newtype Signature curve hash = Signature Bytes
deriving (Int -> Signature curve hash -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall curve hash. Int -> Signature curve hash -> ShowS
forall curve hash. [Signature curve hash] -> ShowS
forall curve hash. Signature curve hash -> String
showList :: [Signature curve hash] -> ShowS
$cshowList :: forall curve hash. [Signature curve hash] -> ShowS
show :: Signature curve hash -> String
$cshow :: forall curve hash. Signature curve hash -> String
showsPrec :: Int -> Signature curve hash -> ShowS
$cshowsPrec :: forall curve hash. Int -> Signature curve hash -> ShowS
Show,Signature curve hash -> Signature curve hash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall curve hash.
Signature curve hash -> Signature curve hash -> Bool
/= :: Signature curve hash -> Signature curve hash -> Bool
$c/= :: forall curve hash.
Signature curve hash -> Signature curve hash -> Bool
== :: Signature curve hash -> Signature curve hash -> Bool
$c== :: forall curve hash.
Signature curve hash -> Signature curve hash -> Bool
Eq,Signature curve hash -> Int
forall p. Signature curve hash -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall curve hash. Signature curve hash -> Int
forall p a. Signature curve hash -> (Ptr p -> IO a) -> IO a
forall curve hash p. Signature curve hash -> Ptr p -> IO ()
forall curve hash p a.
Signature curve hash -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: forall p. Signature curve hash -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall curve hash p. Signature curve hash -> Ptr p -> IO ()
withByteArray :: forall p a. Signature curve hash -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall curve hash p a.
Signature curve hash -> (Ptr p -> IO a) -> IO a
length :: Signature curve hash -> Int
$clength :: forall curve hash. Signature curve hash -> Int
ByteArrayAccess,Signature curve hash -> ()
forall a. (a -> ()) -> NFData a
forall curve hash. Signature curve hash -> ()
rnf :: Signature curve hash -> ()
$crnf :: forall curve hash. Signature curve hash -> ()
NFData)
class ( EllipticCurveBasepointArith curve
, KnownNat (CurveDigestSize curve)
) => EllipticCurveEdDSA curve where
type CurveDigestSize curve :: Nat
secretKeySize :: proxy curve -> Int
hashWithDom :: (HashAlgorithm hash, ByteArrayAccess ctx, ByteArrayAccess msg)
=> proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
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)
scheduleSecret :: ( HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
)
=> proxy curve
-> hash
-> SecretKey curve
-> (Scalar curve, View Bytes)
publicKeySize :: EllipticCurveEdDSA curve => proxy curve -> Int
publicKeySize :: forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
publicKeySize proxy curve
prx = forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
prx forall a. Integral a => a -> a -> a
`div` Int
2
signatureSize :: forall proxy curve . EllipticCurveEdDSA curve
=> proxy curve -> Int
signatureSize :: forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
_ = forall (bitlen :: Nat) a (proxy :: Nat -> *).
(KnownNat bitlen, Num a) =>
proxy bitlen -> a
integralNatVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy (CurveDigestSize curve))
publicKey :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ba
)
=> proxy curve -> hash -> ba -> CryptoFailable (PublicKey curve hash)
publicKey :: forall curve hash ba (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ba) =>
proxy curve -> hash -> ba -> CryptoFailable (PublicKey curve hash)
publicKey proxy curve
prx hash
_ ba
bs
| forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs forall a. Eq a => a -> a -> Bool
== forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
publicKeySize proxy curve
prx =
forall a. a -> CryptoFailable a
CryptoPassed (forall curve hash. Bytes -> PublicKey curve hash
PublicKey forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ba
bs)
| Bool
otherwise =
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_PublicKeySizeInvalid
secretKey :: (EllipticCurveEdDSA curve, ByteArrayAccess ba)
=> proxy curve -> ba -> CryptoFailable (SecretKey curve)
secretKey :: forall curve ba (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess ba) =>
proxy curve -> ba -> CryptoFailable (SecretKey curve)
secretKey proxy curve
prx ba
bs
| forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs forall a. Eq a => a -> a -> Bool
== forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
secretKeySize proxy curve
prx =
forall a. a -> CryptoFailable a
CryptoPassed (forall curve. ScrubbedBytes -> SecretKey curve
SecretKey forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ba
bs)
| Bool
otherwise =
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SecretKeyStructureInvalid
signature :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ba
)
=> proxy curve -> hash -> ba -> CryptoFailable (Signature curve hash)
signature :: forall curve hash ba (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ba) =>
proxy curve -> hash -> ba -> CryptoFailable (Signature curve hash)
signature proxy curve
prx hash
_ ba
bs
| forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs forall a. Eq a => a -> a -> Bool
== forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
prx =
forall a. a -> CryptoFailable a
CryptoPassed (forall curve hash. Bytes -> Signature curve hash
Signature forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ba
bs)
| Bool
otherwise =
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SecretKeyStructureInvalid
generateSecretKey :: (EllipticCurveEdDSA curve, MonadRandom m)
=> proxy curve -> m (SecretKey curve)
generateSecretKey :: forall curve (m :: * -> *) (proxy :: * -> *).
(EllipticCurveEdDSA curve, MonadRandom m) =>
proxy curve -> m (SecretKey curve)
generateSecretKey proxy curve
prx = forall curve. ScrubbedBytes -> SecretKey curve
SecretKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes (forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
secretKeySize proxy curve
prx)
toPublic :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
)
=> proxy curve -> hash -> SecretKey curve -> PublicKey curve hash
toPublic :: forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve -> hash -> SecretKey curve -> PublicKey curve hash
toPublic proxy curve
prx hash
alg SecretKey curve
priv =
let p :: Point curve
p = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Point curve
pointBaseSmul proxy curve
prx (forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve -> hash -> SecretKey curve -> Scalar curve
secretScalar proxy curve
prx hash
alg SecretKey curve
priv)
in forall curve (proxy :: * -> *) hash.
EllipticCurveEdDSA curve =>
proxy curve -> Point curve -> PublicKey curve hash
pointPublic proxy curve
prx Point curve
p
secretScalar :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
)
=> proxy curve -> hash -> SecretKey curve -> Scalar curve
secretScalar :: forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve -> hash -> SecretKey curve -> Scalar curve
secretScalar proxy curve
prx hash
alg SecretKey curve
priv = forall a b. (a, b) -> a
fst (forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve
-> hash -> SecretKey curve -> (Scalar curve, View Bytes)
scheduleSecret proxy curve
prx hash
alg SecretKey curve
priv)
sign :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess msg
)
=> proxy curve -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash
sign :: forall curve hash msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve,
ByteArrayAccess msg) =>
proxy curve
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
sign proxy curve
prx = forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signCtx proxy curve
prx Bytes
emptyCtx
verify :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess msg
)
=> proxy curve -> PublicKey curve hash -> msg -> Signature curve hash -> Bool
verify :: forall curve hash msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve,
ByteArrayAccess msg) =>
proxy curve
-> PublicKey curve hash -> msg -> Signature curve hash -> Bool
verify proxy curve
prx = forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyCtx proxy curve
prx Bytes
emptyCtx
signCtx :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
, ByteArrayAccess msg
)
=> proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash
signCtx :: forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signCtx proxy curve
prx = forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signPhCtx proxy curve
prx Bool
False
verifyCtx :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
, ByteArrayAccess msg
)
=> proxy curve -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool
verifyCtx :: forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyCtx proxy curve
prx = forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyPhCtx proxy curve
prx Bool
False
signPh :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
)
=> proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> Digest prehash -> Signature curve hash
signPh :: forall curve hash ctx (proxy :: * -> *) prehash.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve,
ByteArrayAccess ctx) =>
proxy curve
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> Digest prehash
-> Signature curve hash
signPh proxy curve
prx = forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signPhCtx proxy curve
prx Bool
True
verifyPh :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
)
=> proxy curve -> ctx -> PublicKey curve hash -> Digest prehash -> Signature curve hash -> Bool
verifyPh :: forall curve hash ctx (proxy :: * -> *) prehash.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve,
ByteArrayAccess ctx) =>
proxy curve
-> ctx
-> PublicKey curve hash
-> Digest prehash
-> Signature curve hash
-> Bool
verifyPh proxy curve
prx = forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyPhCtx proxy curve
prx Bool
True
signPhCtx :: forall proxy curve hash ctx msg .
( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
, ByteArrayAccess msg
)
=> proxy curve -> Bool -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash
signPhCtx :: forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signPhCtx proxy curve
prx Bool
ph ctx
ctx SecretKey curve
priv PublicKey curve hash
pub msg
msg =
let alg :: hash
alg = forall a. HasCallStack => a
undefined :: hash
(Scalar curve
s, View Bytes
prefix) = forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve
-> hash -> SecretKey curve -> (Scalar curve, View Bytes)
scheduleSecret proxy curve
prx hash
alg SecretKey curve
priv
digR :: Bytes
digR = forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
hashWithDom proxy curve
prx hash
alg Bool
ph ctx
ctx (forall ba. ByteArrayAccess ba => ba -> Builder
bytes View Bytes
prefix) msg
msg
r :: Scalar curve
r = forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy curve
prx Bytes
digR
pR :: Point curve
pR = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Point curve
pointBaseSmul proxy curve
prx Scalar curve
r
bsR :: Bytes
bsR = forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> Point curve -> bs
encodePoint proxy curve
prx Point curve
pR
sK :: Scalar curve
sK = forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Bytes
-> msg
-> Scalar curve
getK proxy curve
prx Bool
ph ctx
ctx PublicKey curve hash
pub Bytes
bsR msg
msg
sS :: Scalar curve
sS = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
scalarAdd proxy curve
prx Scalar curve
r (forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
scalarMul proxy curve
prx Scalar curve
sK Scalar curve
s)
in forall curve (proxy :: * -> *) hash.
EllipticCurveEdDSA curve =>
proxy curve
-> (Bytes, Point curve, Scalar curve) -> Signature curve hash
encodeSignature proxy curve
prx (Bytes
bsR, Point curve
pR, Scalar curve
sS)
verifyPhCtx :: ( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
, ByteArrayAccess msg
)
=> proxy curve -> Bool -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool
verifyPhCtx :: forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyPhCtx proxy curve
prx Bool
ph ctx
ctx PublicKey curve hash
pub msg
msg Signature curve hash
sig =
case CryptoFailable Bool
doVerify of
CryptoPassed Bool
verified -> Bool
verified
CryptoFailed CryptoError
_ -> Bool
False
where
doVerify :: CryptoFailable Bool
doVerify = do
(Bytes
bsR, Point curve
pR, Scalar curve
sS) <- forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve,
HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve
-> Signature curve hash
-> CryptoFailable (Bytes, Point curve, Scalar curve)
decodeSignature proxy curve
prx Signature curve hash
sig
Point curve
nPub <- forall curve (proxy :: * -> *).
EllipticCurveArith curve =>
proxy curve -> Point curve -> Point curve
pointNegate proxy curve
prx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall curve (proxy :: * -> *) hash.
EllipticCurveEdDSA curve =>
proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve)
publicPoint proxy curve
prx PublicKey curve hash
pub
let sK :: Scalar curve
sK = forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Bytes
-> msg
-> Scalar curve
getK proxy curve
prx Bool
ph ctx
ctx PublicKey curve hash
pub Bytes
bsR msg
msg
pR' :: Point curve
pR' = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve
-> Scalar curve -> Scalar curve -> Point curve -> Point curve
pointsSmulVarTime proxy curve
prx Scalar curve
sS Scalar curve
sK Point curve
nPub
forall (m :: * -> *) a. Monad m => a -> m a
return (Point curve
pR forall a. Eq a => a -> a -> Bool
== Point curve
pR')
emptyCtx :: Bytes
emptyCtx :: Bytes
emptyCtx = forall a. ByteArray a => a
B.empty
getK :: forall proxy curve hash ctx msg .
( EllipticCurveEdDSA curve
, HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ctx
, ByteArrayAccess msg
)
=> proxy curve -> Bool -> ctx -> PublicKey curve hash -> Bytes -> msg -> Scalar curve
getK :: forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Bytes
-> msg
-> Scalar curve
getK proxy curve
prx Bool
ph ctx
ctx (PublicKey Bytes
pub) Bytes
bsR msg
msg =
let alg :: hash
alg = forall a. HasCallStack => a
undefined :: hash
digK :: Bytes
digK = forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash, ByteArrayAccess ctx,
ByteArrayAccess msg) =>
proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
hashWithDom proxy curve
prx hash
alg Bool
ph ctx
ctx (forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
bsR forall a. Semigroup a => a -> a -> a
<> forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
pub) msg
msg
in forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy curve
prx Bytes
digK
encodeSignature :: EllipticCurveEdDSA curve
=> proxy curve
-> (Bytes, Point curve, Scalar curve)
-> Signature curve hash
encodeSignature :: forall curve (proxy :: * -> *) hash.
EllipticCurveEdDSA curve =>
proxy curve
-> (Bytes, Point curve, Scalar curve) -> Signature curve hash
encodeSignature proxy curve
prx (Bytes
bsR, Point curve
_, Scalar curve
sS) = forall curve hash. Bytes -> Signature curve hash
Signature forall a b. (a -> b) -> a -> b
$ forall ba. ByteArray ba => Builder -> ba
buildAndFreeze forall a b. (a -> b) -> a -> b
$
forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
bsR forall a. Semigroup a => a -> a -> a
<> forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
bsS forall a. Semigroup a => a -> a -> a
<> Int -> Builder
zero Int
len0
where
bsS :: Bytes
bsS = forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArray bs) =>
proxy curve -> Scalar curve -> bs
encodeScalarLE proxy curve
prx Scalar curve
sS :: Bytes
len0 :: Int
len0 = forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
prx forall a. Num a => a -> a -> a
- forall ba. ByteArrayAccess ba => ba -> Int
B.length Bytes
bsR forall a. Num a => a -> a -> a
- forall ba. ByteArrayAccess ba => ba -> Int
B.length Bytes
bsS
decodeSignature :: ( EllipticCurveEdDSA curve
, HashDigestSize hash ~ CurveDigestSize curve
)
=> proxy curve
-> Signature curve hash
-> CryptoFailable (Bytes, Point curve, Scalar curve)
decodeSignature :: forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve,
HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve
-> Signature curve hash
-> CryptoFailable (Bytes, Point curve, Scalar curve)
decodeSignature proxy curve
prx (Signature Bytes
bs) = do
let (Bytes
bsR, Bytes
bsS) = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt (forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
publicKeySize proxy curve
prx) Bytes
bs
Point curve
pR <- forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Point curve)
decodePoint proxy curve
prx Bytes
bsR
Scalar curve
sS <- forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
decodeScalarLE proxy curve
prx Bytes
bsS
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
bsR, Point curve
pR, Scalar curve
sS)
decodeScalarNoErr :: (EllipticCurveEdDSA curve, ByteArrayAccess bs)
=> proxy curve -> bs -> Scalar curve
decodeScalarNoErr :: forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy curve
prx = forall a. String -> CryptoFailable a -> a
unwrap String
"decodeScalarNoErr" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
decodeScalarLE proxy curve
prx
unwrap :: String -> CryptoFailable a -> a
unwrap :: forall a. String -> CryptoFailable a -> a
unwrap String
name (CryptoFailed CryptoError
_) = forall a. HasCallStack => String -> a
error (String
name forall a. [a] -> [a] -> [a]
++ String
": assumption failed")
unwrap String
_ (CryptoPassed a
x) = a
x
instance EllipticCurveEdDSA Curve_Edwards25519 where
type CurveDigestSize Curve_Edwards25519 = 64
secretKeySize :: forall (proxy :: * -> *). proxy Curve_Edwards25519 -> Int
secretKeySize proxy Curve_Edwards25519
_ = Int
32
hashWithDom :: forall hash ctx msg (proxy :: * -> *).
(HashAlgorithm hash, ByteArrayAccess ctx, ByteArrayAccess msg) =>
proxy Curve_Edwards25519
-> hash -> Bool -> ctx -> Builder -> msg -> Bytes
hashWithDom proxy Curve_Edwards25519
_ hash
alg Bool
ph ctx
ctx Builder
bss
| Bool -> Bool
not Bool
ph Bool -> Bool -> Bool
&& forall a. ByteArrayAccess a => a -> Bool
B.null ctx
ctx = forall alg msg.
(HashAlgorithm alg, ByteArrayAccess msg) =>
alg -> Builder -> msg -> Bytes
digestDomMsg hash
alg Builder
bss
| Bool
otherwise = forall alg msg.
(HashAlgorithm alg, ByteArrayAccess msg) =>
alg -> Builder -> msg -> Bytes
digestDomMsg hash
alg (Builder
dom forall a. Semigroup a => a -> a -> a
<> Builder
bss)
where dom :: Builder
dom = forall ba. ByteArrayAccess ba => ba -> Builder
bytes (ByteString
"SigEd25519 no Ed25519 collisions" :: ByteString) forall a. Semigroup a => a -> a -> a
<>
Word8 -> Builder
byte (if Bool
ph then Word8
1 else Word8
0) forall a. Semigroup a => a -> a -> a
<>
Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Int
B.length ctx
ctx) forall a. Semigroup a => a -> a -> a
<>
forall ba. ByteArrayAccess ba => ba -> Builder
bytes ctx
ctx
pointPublic :: forall (proxy :: * -> *) hash.
proxy Curve_Edwards25519
-> Point Curve_Edwards25519 -> PublicKey Curve_Edwards25519 hash
pointPublic proxy Curve_Edwards25519
_ = forall curve hash. Bytes -> PublicKey curve hash
PublicKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bs. ByteArray bs => Point -> bs
Edwards25519.pointEncode
publicPoint :: forall (proxy :: * -> *) hash.
proxy Curve_Edwards25519
-> PublicKey Curve_Edwards25519 hash
-> CryptoFailable (Point Curve_Edwards25519)
publicPoint proxy Curve_Edwards25519
_ = forall bs. ByteArrayAccess bs => bs -> CryptoFailable Point
Edwards25519.pointDecode
encodeScalarLE :: forall bs (proxy :: * -> *).
ByteArray bs =>
proxy Curve_Edwards25519 -> Scalar Curve_Edwards25519 -> bs
encodeScalarLE proxy Curve_Edwards25519
_ = forall bs. ByteArray bs => Scalar -> bs
Edwards25519.scalarEncode
decodeScalarLE :: forall bs (proxy :: * -> *).
ByteArrayAccess bs =>
proxy Curve_Edwards25519
-> bs -> CryptoFailable (Scalar Curve_Edwards25519)
decodeScalarLE proxy Curve_Edwards25519
_ = forall bs. ByteArrayAccess bs => bs -> CryptoFailable Scalar
Edwards25519.scalarDecodeLong
scheduleSecret :: forall hash (proxy :: * -> *).
(HashAlgorithm hash,
HashDigestSize hash ~ CurveDigestSize Curve_Edwards25519) =>
proxy Curve_Edwards25519
-> hash
-> SecretKey Curve_Edwards25519
-> (Scalar Curve_Edwards25519, View Bytes)
scheduleSecret proxy Curve_Edwards25519
prx hash
alg SecretKey Curve_Edwards25519
priv =
(forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy Curve_Edwards25519
prx Bytes
clamped, forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.dropView Bytes
hashed Int
32)
where
hashed :: Bytes
hashed = forall alg.
HashAlgorithm alg =>
alg
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
digest hash
alg forall a b. (a -> b) -> a -> b
$ \forall bs. ByteArrayAccess bs => bs -> IO ()
update -> forall bs. ByteArrayAccess bs => bs -> IO ()
update SecretKey Curve_Edwards25519
priv
clamped :: Bytes
clamped :: Bytes
clamped = forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze (forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.takeView Bytes
hashed Int
32) forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Word8
b0 <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
p Int
0 :: IO Word8
Word8
b31 <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
p Int
31 :: IO Word8
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
p Int
31 ((Word8
b31 forall a. Bits a => a -> a -> a
.&. Word8
0x7F) forall a. Bits a => a -> a -> a
.|. Word8
0x40)
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
p Int
0 (Word8
b0 forall a. Bits a => a -> a -> a
.&. Word8
0xF8)
digestDomMsg :: (HashAlgorithm alg, ByteArrayAccess msg)
=> alg -> Builder -> msg -> Bytes
digestDomMsg :: forall alg msg.
(HashAlgorithm alg, ByteArrayAccess msg) =>
alg -> Builder -> msg -> Bytes
digestDomMsg alg
alg Builder
bss msg
bs = forall alg.
HashAlgorithm alg =>
alg
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
digest alg
alg forall a b. (a -> b) -> a -> b
$ \forall bs. ByteArrayAccess bs => bs -> IO ()
update ->
forall bs. ByteArrayAccess bs => bs -> IO ()
update (forall ba. ByteArray ba => Builder -> ba
buildAndFreeze Builder
bss :: Bytes) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall bs. ByteArrayAccess bs => bs -> IO ()
update msg
bs
digest :: HashAlgorithm alg
=> alg
-> ((forall bs . ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
digest :: forall alg.
HashAlgorithm alg =>
alg
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
digest alg
alg (forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ()
fn = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ do
MutableContext alg
mc <- forall alg. HashAlgorithm alg => alg -> IO (MutableContext alg)
hashMutableInitWith alg
alg
(forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ()
fn (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
MutableContext a -> ba -> IO ()
hashMutableUpdate MutableContext alg
mc)
forall a. HashAlgorithm a => MutableContext a -> IO (Digest a)
hashMutableFinalize MutableContext alg
mc