module Tezos.Crypto.Secp256k1
(
PublicKey (..)
, SecretKey
, Signature (..)
, detSecretKey
, detSecretKeyDo
, toPublic
, publicKeyToBytes
, mkPublicKey
, publicKeyLengthBytes
, signatureToBytes
, mkSignature
, signatureLengthBytes
, formatPublicKey
, mformatPublicKey
, parsePublicKey
, formatSignature
, mformatSignature
, parseSignature
, formatSecretKey
, parseSecretKey
, sign
, checkSignature
) where
import Crypto.Hash (Blake2b_256(..))
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.ECC.Generate as ECC.Generate
import Crypto.PubKey.ECC.Types (Curve(..), CurveName(..), getCurveByName)
import Crypto.Random (MonadRandom, drgNewSeed, seedFromInteger, withDRG)
import Data.ByteArray (ByteArray, ByteArrayAccess)
import qualified Data.ByteString as BS
import Fmt (Buildable, build)
import Test.QuickCheck (Arbitrary(..), vector)
import Michelson.Text
import Tezos.Crypto.Util
curve :: Curve
curve :: Curve
curve = CurveName -> Curve
getCurveByName CurveName
SEC_p256k1
newtype PublicKey = PublicKey
{ PublicKey -> PublicKey
unPublicKey :: ECDSA.PublicKey
} deriving stock (PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c== :: PublicKey -> PublicKey -> Bool
Eq, Int -> PublicKey -> ShowS
[PublicKey] -> ShowS
PublicKey -> String
(Int -> PublicKey -> ShowS)
-> (PublicKey -> String)
-> ([PublicKey] -> ShowS)
-> Show PublicKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKey] -> ShowS
$cshowList :: [PublicKey] -> ShowS
show :: PublicKey -> String
$cshow :: PublicKey -> String
showsPrec :: Int -> PublicKey -> ShowS
$cshowsPrec :: Int -> PublicKey -> ShowS
Show, (forall x. PublicKey -> Rep PublicKey x)
-> (forall x. Rep PublicKey x -> PublicKey) -> Generic PublicKey
forall x. Rep PublicKey x -> PublicKey
forall x. PublicKey -> Rep PublicKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PublicKey x -> PublicKey
$cfrom :: forall x. PublicKey -> Rep PublicKey x
Generic)
instance Arbitrary PublicKey where
arbitrary :: Gen PublicKey
arbitrary = SecretKey -> PublicKey
toPublic (SecretKey -> PublicKey) -> Gen SecretKey -> Gen PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SecretKey
forall a. Arbitrary a => Gen a
arbitrary
instance NFData PublicKey where
rnf :: PublicKey -> ()
rnf (PublicKey (ECDSA.PublicKey cu :: Curve
cu q :: PublicPoint
q))
= Curve -> ()
rnfCurve Curve
cu () -> () -> ()
forall a b. a -> b -> b
`seq` PublicPoint -> ()
forall a. NFData a => a -> ()
rnf PublicPoint
q
newtype SecretKey = SecretKey
{ SecretKey -> KeyPair
unSecretKey :: ECDSA.KeyPair
} deriving stock (Int -> SecretKey -> ShowS
[SecretKey] -> ShowS
SecretKey -> String
(Int -> SecretKey -> ShowS)
-> (SecretKey -> String)
-> ([SecretKey] -> ShowS)
-> Show SecretKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecretKey] -> ShowS
$cshowList :: [SecretKey] -> ShowS
show :: SecretKey -> String
$cshow :: SecretKey -> String
showsPrec :: Int -> SecretKey -> ShowS
$cshowsPrec :: Int -> SecretKey -> ShowS
Show, SecretKey -> SecretKey -> Bool
(SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool) -> Eq SecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c== :: SecretKey -> SecretKey -> Bool
Eq, (forall x. SecretKey -> Rep SecretKey x)
-> (forall x. Rep SecretKey x -> SecretKey) -> Generic SecretKey
forall x. Rep SecretKey x -> SecretKey
forall x. SecretKey -> Rep SecretKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SecretKey x -> SecretKey
$cfrom :: forall x. SecretKey -> Rep SecretKey x
Generic)
instance NFData SecretKey where
rnf :: SecretKey -> ()
rnf (SecretKey (ECDSA.KeyPair cu :: Curve
cu pp :: PublicPoint
pp pn :: PrivateNumber
pn)) =
Curve -> ()
rnfCurve Curve
cu () -> () -> ()
forall a b. a -> b -> b
`seq` (PublicPoint, PrivateNumber) -> ()
forall a. NFData a => a -> ()
rnf (PublicPoint
pp, PrivateNumber
pn)
detSecretKey :: ByteString -> SecretKey
detSecretKey :: ByteString -> SecretKey
detSecretKey seed :: ByteString
seed = ByteString -> MonadPseudoRandom ChaChaDRG SecretKey -> SecretKey
forall a. ByteString -> MonadPseudoRandom ChaChaDRG a -> a
deterministic ByteString
seed (MonadPseudoRandom ChaChaDRG SecretKey -> SecretKey)
-> MonadPseudoRandom ChaChaDRG SecretKey -> SecretKey
forall a b. (a -> b) -> a -> b
$ MonadPseudoRandom ChaChaDRG SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
detSecretKeyDo
detSecretKeyDo :: MonadRandom m => m SecretKey
detSecretKeyDo :: m SecretKey
detSecretKeyDo = KeyPair -> SecretKey
SecretKey (KeyPair -> SecretKey) -> m KeyPair -> m SecretKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
(publicKey :: PublicKey
publicKey, privateKey :: PrivateKey
privateKey) <- Curve -> m (PublicKey, PrivateKey)
forall (m :: * -> *).
MonadRandom m =>
Curve -> m (PublicKey, PrivateKey)
ECC.Generate.generate Curve
curve
KeyPair -> m KeyPair
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPair -> m KeyPair) -> KeyPair -> m KeyPair
forall a b. (a -> b) -> a -> b
$
Curve -> PublicPoint -> PrivateNumber -> KeyPair
ECDSA.KeyPair Curve
curve (PublicKey -> PublicPoint
ECDSA.public_q PublicKey
publicKey) (PrivateKey -> PrivateNumber
ECDSA.private_d PrivateKey
privateKey)
instance Arbitrary SecretKey where
arbitrary :: Gen SecretKey
arbitrary = ByteString -> SecretKey
detSecretKey (ByteString -> SecretKey)
-> ([Word8] -> ByteString) -> [Word8] -> SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> SecretKey) -> Gen [Word8] -> Gen SecretKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector 32
toPublic :: SecretKey -> PublicKey
toPublic :: SecretKey -> PublicKey
toPublic =
PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey)
-> (SecretKey -> PublicKey) -> SecretKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Curve -> PublicPoint -> PublicKey
ECDSA.PublicKey Curve
curve (PublicPoint -> PublicKey)
-> (SecretKey -> PublicPoint) -> SecretKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(ECDSA.KeyPair _ pp :: PublicPoint
pp _) -> PublicPoint
pp) (KeyPair -> PublicPoint)
-> (SecretKey -> KeyPair) -> SecretKey -> PublicPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> KeyPair
unSecretKey
newtype Signature = Signature
{ Signature -> Signature
unSignature :: ECDSA.Signature
} deriving stock (Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signature] -> ShowS
$cshowList :: [Signature] -> ShowS
show :: Signature -> String
$cshow :: Signature -> String
showsPrec :: Int -> Signature -> ShowS
$cshowsPrec :: Int -> Signature -> ShowS
Show, Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c== :: Signature -> Signature -> Bool
Eq, (forall x. Signature -> Rep Signature x)
-> (forall x. Rep Signature x -> Signature) -> Generic Signature
forall x. Rep Signature x -> Signature
forall x. Signature -> Rep Signature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Signature x -> Signature
$cfrom :: forall x. Signature -> Rep Signature x
Generic)
instance Arbitrary Signature where
arbitrary :: Gen Signature
arbitrary = do
ChaChaDRG
seed <- Seed -> ChaChaDRG
drgNewSeed (Seed -> ChaChaDRG)
-> (PrivateNumber -> Seed) -> PrivateNumber -> ChaChaDRG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateNumber -> Seed
seedFromInteger (PrivateNumber -> ChaChaDRG) -> Gen PrivateNumber -> Gen ChaChaDRG
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PrivateNumber
forall a. Arbitrary a => Gen a
arbitrary
Word8
byteToSign <- Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
return $ (Signature, ChaChaDRG) -> Signature
forall a b. (a, b) -> a
fst ((Signature, ChaChaDRG) -> Signature)
-> (Signature, ChaChaDRG) -> Signature
forall a b. (a -> b) -> a -> b
$ ChaChaDRG
-> MonadPseudoRandom ChaChaDRG Signature -> (Signature, ChaChaDRG)
forall gen a. DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
withDRG ChaChaDRG
seed (MonadPseudoRandom ChaChaDRG Signature -> (Signature, ChaChaDRG))
-> MonadPseudoRandom ChaChaDRG Signature -> (Signature, ChaChaDRG)
forall a b. (a -> b) -> a -> b
$ do
SecretKey
sk <- MonadPseudoRandom ChaChaDRG SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
detSecretKeyDo
SecretKey -> ByteString -> MonadPseudoRandom ChaChaDRG Signature
forall (m :: * -> *).
MonadRandom m =>
SecretKey -> ByteString -> m Signature
sign SecretKey
sk (OneItem ByteString -> ByteString
forall x. One x => OneItem x -> x
one Word8
OneItem ByteString
byteToSign)
instance NFData Signature where
rnf :: Signature -> ()
rnf (Signature (ECDSA.Signature a :: PrivateNumber
a b :: PrivateNumber
b)) = PrivateNumber -> ()
forall a. NFData a => a -> ()
rnf PrivateNumber
a () -> () -> ()
forall a b. a -> b -> b
`seq` PrivateNumber -> ()
forall a. NFData a => a -> ()
rnf PrivateNumber
b
publicKeyToBytes :: forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes :: PublicKey -> ba
publicKeyToBytes (PublicKey p :: PublicKey
p) =
Curve -> PublicKey -> ba
forall ba. (ByteArray ba, HasCallStack) => Curve -> PublicKey -> ba
publicKeyToBytes_ Curve
curve PublicKey
p
mkPublicKey :: ByteArrayAccess ba => ba -> Either CryptoParseError PublicKey
mkPublicKey :: ba -> Either CryptoParseError PublicKey
mkPublicKey ba :: ba
ba = PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey)
-> Either CryptoParseError PublicKey
-> Either CryptoParseError PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Curve -> ba -> Either CryptoParseError PublicKey
forall ba.
ByteArrayAccess ba =>
Curve -> ba -> Either CryptoParseError PublicKey
mkPublicKey_ Curve
curve ba
ba
publicKeyLengthBytes :: Integral n => n
publicKeyLengthBytes :: n
publicKeyLengthBytes = Curve -> n
forall n. Integral n => Curve -> n
publicKeyLengthBytes_ Curve
curve
signatureToBytes :: ByteArray ba => Signature -> ba
signatureToBytes :: Signature -> ba
signatureToBytes (Signature sig :: Signature
sig) =
Curve -> Signature -> ba
forall ba. ByteArray ba => Curve -> Signature -> ba
signatureToBytes_ Curve
curve Signature
sig
mkSignature :: ByteArray ba => ba -> Either CryptoParseError Signature
mkSignature :: ba -> Either CryptoParseError Signature
mkSignature ba :: ba
ba = Signature -> Signature
Signature (Signature -> Signature)
-> Either CryptoParseError Signature
-> Either CryptoParseError Signature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Curve -> ba -> Either CryptoParseError Signature
forall ba.
ByteArray ba =>
Curve -> ba -> Either CryptoParseError Signature
mkSignature_ Curve
curve ba
ba
signatureLengthBytes :: Integral n => n
signatureLengthBytes :: n
signatureLengthBytes = Curve -> n
forall n. Integral n => Curve -> n
signatureLengthBytes_ Curve
curve
mkSecretKey :: ByteArray ba => ba -> Either CryptoParseError SecretKey
mkSecretKey :: ba -> Either CryptoParseError SecretKey
mkSecretKey = SecretKey -> Either CryptoParseError SecretKey
forall a b. b -> Either a b
Right (SecretKey -> Either CryptoParseError SecretKey)
-> (ba -> SecretKey) -> ba -> Either CryptoParseError SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> SecretKey
SecretKey (KeyPair -> SecretKey) -> (ba -> KeyPair) -> ba -> SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curve -> ba -> KeyPair
forall ba. ByteArray ba => Curve -> ba -> KeyPair
mkSecretKey_ Curve
curve
secretKeyToBytes :: ByteArray ba => SecretKey -> ba
secretKeyToBytes :: SecretKey -> ba
secretKeyToBytes (SecretKey kp :: KeyPair
kp) =
KeyPair -> ba
forall ba. ByteArray ba => KeyPair -> ba
secretKeyToBytes_ KeyPair
kp
publicKeyTag :: ByteString
publicKeyTag :: ByteString
publicKeyTag = "\003\254\226\086"
secretKeyTag :: ByteString
secretKeyTag :: ByteString
secretKeyTag = "\017\162\224\201"
signatureTag :: ByteString
signatureTag :: ByteString
signatureTag = "\013\115\101\019\063"
formatPublicKey :: PublicKey -> Text
formatPublicKey :: PublicKey -> Text
formatPublicKey = ByteString -> ByteString -> Text
forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl @ByteString ByteString
publicKeyTag (ByteString -> Text)
-> (PublicKey -> ByteString) -> PublicKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes
mformatPublicKey :: PublicKey -> MText
mformatPublicKey :: PublicKey -> MText
mformatPublicKey = HasCallStack => Text -> MText
Text -> MText
mkMTextUnsafe (Text -> MText) -> (PublicKey -> Text) -> PublicKey -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Text
formatPublicKey
instance Buildable PublicKey where
build :: PublicKey -> Builder
build = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (PublicKey -> Text) -> PublicKey -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Text
formatPublicKey
parsePublicKey :: Text -> Either CryptoParseError PublicKey
parsePublicKey :: Text -> Either CryptoParseError PublicKey
parsePublicKey = ByteString
-> (ByteString -> Either CryptoParseError PublicKey)
-> Text
-> Either CryptoParseError PublicKey
forall res.
ByteString
-> (ByteString -> Either CryptoParseError res)
-> Text
-> Either CryptoParseError res
parseImpl ByteString
publicKeyTag ByteString -> Either CryptoParseError PublicKey
forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError PublicKey
mkPublicKey
formatSignature :: Signature -> Text
formatSignature :: Signature -> Text
formatSignature = ByteString -> ByteString -> Text
forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl @ByteString ByteString
signatureTag (ByteString -> Text)
-> (Signature -> ByteString) -> Signature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
forall ba. ByteArray ba => Signature -> ba
signatureToBytes
mformatSignature :: Signature -> MText
mformatSignature :: Signature -> MText
mformatSignature = HasCallStack => Text -> MText
Text -> MText
mkMTextUnsafe (Text -> MText) -> (Signature -> Text) -> Signature -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Text
formatSignature
instance Buildable Signature where
build :: Signature -> Builder
build = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (Signature -> Text) -> Signature -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Text
formatSignature
parseSignature :: Text -> Either CryptoParseError Signature
parseSignature :: Text -> Either CryptoParseError Signature
parseSignature = ByteString
-> (ByteString -> Either CryptoParseError Signature)
-> Text
-> Either CryptoParseError Signature
forall res.
ByteString
-> (ByteString -> Either CryptoParseError res)
-> Text
-> Either CryptoParseError res
parseImpl ByteString
signatureTag ByteString -> Either CryptoParseError Signature
forall ba. ByteArray ba => ba -> Either CryptoParseError Signature
mkSignature
formatSecretKey :: SecretKey -> Text
formatSecretKey :: SecretKey -> Text
formatSecretKey = ByteString -> ByteString -> Text
forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl @ByteString ByteString
secretKeyTag (ByteString -> Text)
-> (SecretKey -> ByteString) -> SecretKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> ByteString
forall ba. ByteArray ba => SecretKey -> ba
secretKeyToBytes
instance Buildable SecretKey where
build :: SecretKey -> Builder
build = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (SecretKey -> Text) -> SecretKey -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> Text
formatSecretKey
parseSecretKey :: Text -> Either CryptoParseError SecretKey
parseSecretKey :: Text -> Either CryptoParseError SecretKey
parseSecretKey = ByteString
-> (ByteString -> Either CryptoParseError SecretKey)
-> Text
-> Either CryptoParseError SecretKey
forall res.
ByteString
-> (ByteString -> Either CryptoParseError res)
-> Text
-> Either CryptoParseError res
parseImpl ByteString
secretKeyTag ByteString -> Either CryptoParseError SecretKey
forall ba. ByteArray ba => ba -> Either CryptoParseError SecretKey
mkSecretKey
sign :: MonadRandom m => SecretKey -> ByteString -> m Signature
sign :: SecretKey -> ByteString -> m Signature
sign (SecretKey keyPair :: KeyPair
keyPair) =
(Signature -> Signature) -> m Signature -> m Signature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Signature -> Signature
Signature (m Signature -> m Signature)
-> (ByteString -> m Signature) -> ByteString -> m Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> Blake2b_256 -> ByteString -> m Signature
forall msg hash (m :: * -> *).
(ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m) =>
PrivateKey -> hash -> msg -> m Signature
ECDSA.sign (KeyPair -> PrivateKey
ECDSA.toPrivateKey KeyPair
keyPair) Blake2b_256
Blake2b_256
checkSignature :: PublicKey -> Signature -> ByteString -> Bool
checkSignature :: PublicKey -> Signature -> ByteString -> Bool
checkSignature (PublicKey pk :: PublicKey
pk) (Signature sig :: Signature
sig) =
Blake2b_256 -> PublicKey -> Signature -> ByteString -> Bool
forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
ECDSA.verify Blake2b_256
Blake2b_256 PublicKey
pk Signature
sig