From a27a66c0b774beef9ee7748a02d8bebec9875a15 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Tue, 15 Feb 2022 07:08:13 +1300 Subject: [PATCH 01/13] Initial bindings --- .../cardano-crypto-class.cabal | 5 +- .../src/Cardano/Crypto/Schnorr.hs | 125 ++++++++++++++++++ 2 files changed, 128 insertions(+), 2 deletions(-) create mode 100644 cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs diff --git a/cardano-crypto-class/cardano-crypto-class.cabal b/cardano-crypto-class/cardano-crypto-class.cabal index e259af960..d8365e22e 100644 --- a/cardano-crypto-class/cardano-crypto-class.cabal +++ b/cardano-crypto-class/cardano-crypto-class.cabal @@ -92,6 +92,7 @@ library Cardano.Foreign other-modules: Cardano.Crypto.PackedBytes + Cardano.Crypto.Schnorr build-depends: aeson , base @@ -112,8 +113,8 @@ library , text , transformers , vector - - pkgconfig-depends: libsodium + + pkgconfig-depends: libsodium, libsecp256k1 test-suite test-memory-example import: base, project-config diff --git a/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs b/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs new file mode 100644 index 000000000..fcd678864 --- /dev/null +++ b/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.Crypto.Schnorr ( + schnorrNonceFunction, + SECP256k1Context, + secpContextNoPrecomp, + secpContextCreate, + secpContextDestroy, + SECP256k1KeyPair, + secpKeyPairCreate, + secpSchnorrSigSign, + SECP256k1XOnlyPubKey, + secpSchnorrSigVerify, + ) where + +import Data.Primitive.Ptr (copyPtr) +import Data.Word (Word8) +import Data.Primitive.ByteArray ( + ByteArray, + newAlignedPinnedByteArray, + byteArrayContents, + mutableByteArrayContents, + unsafeFreezeByteArray, + ) +import Foreign.Storable (Storable (sizeOf, alignment, peek, poke)) +import Foreign.Ptr (Ptr, castPtr) +import Foreign.C.Types (CUChar, CSize (CSize), CInt (CInt)) + +foreign import capi "secp256k1_schnorrsig.h secp256k1_nonce_function_bip340" + schnorrNonceFunction :: + Ptr CUChar -- out-param for nonce (32 bytes) + -> Ptr CUChar -- message being verified, only NULL when message length is 0 + -> CSize -- message length + -> Ptr CUChar -- secret key (not NULL, 32 bytes) + -> Ptr CUChar -- serialized xonly pubkey corresponding to secret key (not NULL, 32 bytes) + -> Ptr CUChar -- description of algorithm (not NULL) + -> CSize -- length of algorithm description + -> Ptr CUChar -- arbitrary passthrough data + -> IO CInt -- 1 on success, 0 on error + +data SECP256k1Context + +foreign import capi "secp256k1.h value secp256k1_context_no_precomp" + secpContextNoPrecomp :: Ptr SECP256k1Context + +foreign import capi "secp256k1.h secp256k1_context_create" + secpContextCreate :: + CInt -- flags + -> IO (Ptr SECP256k1Context) + +foreign import capi "secp256k1.h secp256k1_context_destroy" + secpContextDestroy :: + Ptr SECP256k1Context + -> IO () + +newtype SECP256k1KeyPair = SECP256k1KeyPair ByteArray + deriving (Eq, Ord) via ByteArray + deriving stock (Show) + +instance Storable SECP256k1KeyPair where + {-# INLINEABLE sizeOf #-} + sizeOf _ = 96 + {-# INLINEABLE alignment #-} + alignment _ = 96 + {-# INLINEABLE peek #-} + peek p = do + let pBytes :: Ptr Word8 = castPtr p + mba <- newAlignedPinnedByteArray 96 96 + let mbaPtr = mutableByteArrayContents mba + copyPtr mbaPtr pBytes 96 + SECP256k1KeyPair <$> unsafeFreezeByteArray mba + {-# INLINEABLE poke #-} + poke p (SECP256k1KeyPair ba) = do + let pBytes :: Ptr Word8 = castPtr p + let baPtr = byteArrayContents ba + copyPtr pBytes baPtr 96 + +foreign import capi "secp256k1_extrakeys.h secp256k1_keypair_create" + secpKeyPairCreate :: + Ptr SECP256k1Context -- context initialized for signing + -> Ptr SECP256k1KeyPair -- out-param for keypair to initialize + -> Ptr CUChar -- secret key (32 bytes) + -> Ptr CInt -- 1 on success, 0 on failure + +foreign import capi "secp256k1_schnorrsig.h secp256k1_schnorrsig_sign" + secpSchnorrSigSign :: + Ptr SECP256k1Context -- context initialized for signing + -> Ptr CUChar -- out-param for signature (64 bytes) + -> Ptr CUChar -- message hash to sign (32 bytes) + -> Ptr SECP256k1KeyPair -- initialized keypair + -> Ptr CUChar -- fresh randomness (32 bytes) + -> IO CInt -- 1 on success, 0 on failure + +newtype SECP256k1XOnlyPubKey = SECP256k1XOnlyPubKey ByteArray + deriving (Eq, Ord) via ByteArray + deriving stock (Show) + +instance Storable SECP256k1XOnlyPubKey where + {-# INLINEABLE sizeOf #-} + sizeOf _ = 64 + {-# INLINEABLE alignment #-} + alignment _ = 64 + {-# INLINEABLE peek #-} + peek p = do + let pBytes :: Ptr Word8 = castPtr p + mba <- newAlignedPinnedByteArray 64 64 + let mbaPtr = mutableByteArrayContents mba + copyPtr mbaPtr pBytes 64 + SECP256k1XOnlyPubKey <$> unsafeFreezeByteArray mba + {-# INLINEABLE poke #-} + poke p (SECP256k1XOnlyPubKey ba) = do + let pBytes :: Ptr Word8 = castPtr p + let baPtr = byteArrayContents ba + copyPtr pBytes baPtr 64 + +foreign import capi "secp256k1_schnorrsig.h secp256k1_schnorrsig_verify" + secpSchnorrSigVerify :: + Ptr SECP256k1Context -- context initialized for verifying + -> Ptr CUChar -- signature to verify (64 bytes) + -> Ptr CUChar -- message to verify + -> CSize -- message length in bytes + -> Ptr SECP256k1XOnlyPubKey -- pubkey to verify with + -> CInt -- 1 on success, 0 on failure From 87b406598f312235fb9cc9ed51c62919a59dec88 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Thu, 17 Feb 2022 10:49:28 +1300 Subject: [PATCH 02/13] Try updating haskell.nix --- nix/sources.json | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/nix/sources.json b/nix/sources.json index 5e1e6edc9..9b933b690 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -18,10 +18,10 @@ "homepage": "https://input-output-hk.github.io/haskell.nix", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "1729233076f84649aee3b98100a378df88cc8675", - "sha256": "14j1zy94bfvcs415ipz8kghbhlcbvp2n6zq5pakmmld1ba1k3qcd", + "rev": "659b73698e06c02cc0f3029383bd383c8acdbe98", + "sha256": "sha256:0i91iwa11sq0v82v0zl82npnb4qqfm71y7gn3giyaixslm73kspk", "type": "tarball", - "url": "https://github.com/input-output-hk/haskell.nix/archive/1729233076f84649aee3b98100a378df88cc8675.tar.gz", + "url": "https://github.com/input-output-hk/haskell.nix/archive/659b73698e06c02cc0f3029383bd383c8acdbe98.tar.gz", "url_template": "https://github.com///archive/.tar.gz", "version": "962ecfed3a4fb656b5a91d89159291e00ed766bc" }, From d085afdc04b1bd904234375060e9d7892b3f3821 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Fri, 18 Feb 2022 10:02:25 +0000 Subject: [PATCH 03/13] Add nixpkgs pin, move to recent revision This allows a more recent version of libsecp256k1 that has schnorr signatures. --- nix/sources.json | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/nix/sources.json b/nix/sources.json index 5e1e6edc9..c35889b3e 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -37,5 +37,17 @@ "url": "https://github.com/input-output-hk/iohk-nix/archive/266ca46a8d1cb4286b9699b4fd435066e88440ac.tar.gz", "url_template": "https://github.com///archive/.tar.gz", "version": "60fe72cf807a4ec4409a53883d5c3af77f60f721" + }, + "nixpkgs": { + "branch": "nixpkgs-unstable", + "description": "Nix Packages collection", + "homepage": "", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "1882c6b7368fd284ad01b0a5b5601ef136321292", + "sha256": "0zg7ak2mcmwzi2kg29g4v9fvbvs0viykjsg2pwaphm1fi13s7s0i", + "type": "tarball", + "url": "https://github.com/nixos/nixpkgs/archive/1882c6b7368fd284ad01b0a5b5601ef136321292.tar.gz", + "url_template": "https://github.com///archive/.tar.gz" } } From 7a8c98bf18324a0bf61bce22defc67e694272a47 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Fri, 18 Feb 2022 10:03:18 +0000 Subject: [PATCH 04/13] Bump haskell.nix --- nix/sources.json | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/nix/sources.json b/nix/sources.json index c35889b3e..e91640494 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -18,10 +18,10 @@ "homepage": "https://input-output-hk.github.io/haskell.nix", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "1729233076f84649aee3b98100a378df88cc8675", - "sha256": "14j1zy94bfvcs415ipz8kghbhlcbvp2n6zq5pakmmld1ba1k3qcd", + "rev": "8ebafe54ded2789ca67109cd712a5e53e5e9da41", + "sha256": "05cvahwnscapa491lck9ign6256r50q257b3s85jfl9aqmvdjy7r", "type": "tarball", - "url": "https://github.com/input-output-hk/haskell.nix/archive/1729233076f84649aee3b98100a378df88cc8675.tar.gz", + "url": "https://github.com/input-output-hk/haskell.nix/archive/8ebafe54ded2789ca67109cd712a5e53e5e9da41.tar.gz", "url_template": "https://github.com///archive/.tar.gz", "version": "962ecfed3a4fb656b5a91d89159291e00ed766bc" }, From e227b99356f9b191d0fa126852de411df48bd459 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Fri, 18 Feb 2022 10:10:19 +0000 Subject: [PATCH 05/13] Fix nixpkgs --- nix/sources.json | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/nix/sources.json b/nix/sources.json index e91640494..7781b9a16 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -39,6 +39,7 @@ "version": "60fe72cf807a4ec4409a53883d5c3af77f60f721" }, "nixpkgs": { + "builtin": true, "branch": "nixpkgs-unstable", "description": "Nix Packages collection", "homepage": "", @@ -47,7 +48,7 @@ "rev": "1882c6b7368fd284ad01b0a5b5601ef136321292", "sha256": "0zg7ak2mcmwzi2kg29g4v9fvbvs0viykjsg2pwaphm1fi13s7s0i", "type": "tarball", - "url": "https://github.com/nixos/nixpkgs/archive/1882c6b7368fd284ad01b0a5b5601ef136321292.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/1882c6b7368fd284ad01b0a5b5601ef136321292.tar.gz", "url_template": "https://github.com///archive/.tar.gz" } } From 68acbf79894508b243a2e5f66495686551a59ab1 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Mon, 21 Feb 2022 08:31:14 +1300 Subject: [PATCH 06/13] Finish FFI bits --- cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs b/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs index fcd678864..5874173ee 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs @@ -5,7 +5,7 @@ module Cardano.Crypto.Schnorr ( schnorrNonceFunction, SECP256k1Context, - secpContextNoPrecomp, +-- secpContextNoPrecomp, secpContextCreate, secpContextDestroy, SECP256k1KeyPair, @@ -42,8 +42,10 @@ foreign import capi "secp256k1_schnorrsig.h secp256k1_nonce_function_bip340" data SECP256k1Context +{- foreign import capi "secp256k1.h value secp256k1_context_no_precomp" secpContextNoPrecomp :: Ptr SECP256k1Context +-} foreign import capi "secp256k1.h secp256k1_context_create" secpContextCreate :: @@ -82,7 +84,7 @@ foreign import capi "secp256k1_extrakeys.h secp256k1_keypair_create" Ptr SECP256k1Context -- context initialized for signing -> Ptr SECP256k1KeyPair -- out-param for keypair to initialize -> Ptr CUChar -- secret key (32 bytes) - -> Ptr CInt -- 1 on success, 0 on failure + -> IO CInt -- 1 on success, 0 on failure foreign import capi "secp256k1_schnorrsig.h secp256k1_schnorrsig_sign" secpSchnorrSigSign :: From 332b95a3f5b4a4fb2406569f0904e7fd92de2ae3 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Mon, 21 Feb 2022 08:57:12 +1300 Subject: [PATCH 07/13] Rename the prior SECP work to be more accurate --- .../cardano-crypto-class.cabal | 2 +- .../src/Cardano/Crypto/DSIGN.hs | 2 +- .../DSIGN/{SECP256k1.hs => EcdsaSecp256k1.hs} | 76 ++++++++++--------- cardano-crypto-tests/src/Test/Crypto/DSIGN.hs | 4 +- 4 files changed, 46 insertions(+), 38 deletions(-) rename cardano-crypto-class/src/Cardano/Crypto/DSIGN/{SECP256k1.hs => EcdsaSecp256k1.hs} (58%) diff --git a/cardano-crypto-class/cardano-crypto-class.cabal b/cardano-crypto-class/cardano-crypto-class.cabal index d8365e22e..cd6c1d654 100644 --- a/cardano-crypto-class/cardano-crypto-class.cabal +++ b/cardano-crypto-class/cardano-crypto-class.cabal @@ -50,7 +50,7 @@ library Cardano.Crypto.DSIGN.Ed448 Cardano.Crypto.DSIGN.Mock Cardano.Crypto.DSIGN.NeverUsed - Cardano.Crypto.DSIGN.SECP256k1 + Cardano.Crypto.DSIGN.EcdsaSecp256k1 Cardano.Crypto.Hash.Blake2b Cardano.Crypto.Hash.Class diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN.hs index c5931db08..8ef74a1fc 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN.hs @@ -9,4 +9,4 @@ import Cardano.Crypto.DSIGN.Ed25519 as X import Cardano.Crypto.DSIGN.Ed448 as X import Cardano.Crypto.DSIGN.Mock as X import Cardano.Crypto.DSIGN.NeverUsed as X -import Cardano.Crypto.DSIGN.SECP256k1 as X +import Cardano.Crypto.DSIGN.EcdsaSecp256k1 as X diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SECP256k1.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/EcdsaSecp256k1.hs similarity index 58% rename from cardano-crypto-class/src/Cardano/Crypto/DSIGN/SECP256k1.hs rename to cardano-crypto-class/src/Cardano/Crypto/DSIGN/EcdsaSecp256k1.hs index 0aeac99b4..3162d4974 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SECP256k1.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/EcdsaSecp256k1.hs @@ -8,7 +8,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-orphans #-} -- need NoThunks for secp256k1-haskell types -module Cardano.Crypto.DSIGN.SECP256k1 where +module Cardano.Crypto.DSIGN.EcdsaSecp256k1 where import Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (toCBOR, encodedSizeExpr)) import Data.ByteString (ByteString) @@ -51,67 +51,75 @@ import Cardano.Crypto.DSIGN.Class ( decodeSigDSIGN ) -data SECP256k1DSIGN +data EcdsaSecp256k1DSIGN -instance NoThunks (VerKeyDSIGN SECP256k1DSIGN) +instance NoThunks (VerKeyDSIGN EcdsaSecp256k1DSIGN) -instance NoThunks (SignKeyDSIGN SECP256k1DSIGN) +instance NoThunks (SignKeyDSIGN EcdsaSecp256k1DSIGN) -instance NoThunks (SigDSIGN SECP256k1DSIGN) +instance NoThunks (SigDSIGN EcdsaSecp256k1DSIGN) -instance DSIGNAlgorithm SECP256k1DSIGN where - type SeedSizeDSIGN SECP256k1DSIGN = 32 - type SizeSigDSIGN SECP256k1DSIGN = 64 - type SizeSignKeyDSIGN SECP256k1DSIGN = 32 - type SizeVerKeyDSIGN SECP256k1DSIGN = 64 - type Signable SECP256k1DSIGN = ((~) SECP.Msg) - newtype VerKeyDSIGN SECP256k1DSIGN = VerKeySECP256k1 SECP.PubKey +instance DSIGNAlgorithm EcdsaSecp256k1DSIGN where + type SeedSizeDSIGN EcdsaSecp256k1DSIGN = 32 + type SizeSigDSIGN EcdsaSecp256k1DSIGN = 64 + type SizeSignKeyDSIGN EcdsaSecp256k1DSIGN = 32 + type SizeVerKeyDSIGN EcdsaSecp256k1DSIGN = 64 + type Signable EcdsaSecp256k1DSIGN = ((~) SECP.Msg) + newtype VerKeyDSIGN EcdsaSecp256k1DSIGN = + VerKeyEcdsaSecp256k1 SECP.PubKey deriving newtype (Eq, NFData) deriving stock (Show, Generic) - newtype SignKeyDSIGN SECP256k1DSIGN = SignKeySECP256k1 SECP.SecKey + newtype SignKeyDSIGN EcdsaSecp256k1DSIGN = + SignKeyEcdsaSecp256k1 SECP.SecKey deriving newtype (Eq, NFData) deriving stock (Show, Generic) - newtype SigDSIGN SECP256k1DSIGN = SigSECP256k1 SECP.Sig + newtype SigDSIGN EcdsaSecp256k1DSIGN = + SigEcdsaSecp256k1 SECP.Sig deriving newtype (Eq, NFData) deriving stock (Show, Generic) - algorithmNameDSIGN _ = "secp256k1" - deriveVerKeyDSIGN (SignKeySECP256k1 sk) = VerKeySECP256k1 . SECP.derivePubKey $ sk - signDSIGN () msg (SignKeySECP256k1 k) = SigSECP256k1 . SECP.signMsg k $ msg - verifyDSIGN () (VerKeySECP256k1 pk) msg (SigSECP256k1 sig) = + algorithmNameDSIGN _ = "ecdsa-secp256k1" + deriveVerKeyDSIGN (SignKeyEcdsaSecp256k1 sk) = + VerKeyEcdsaSecp256k1 . SECP.derivePubKey $ sk + signDSIGN () msg (SignKeyEcdsaSecp256k1 k) = + SigEcdsaSecp256k1 . SECP.signMsg k $ msg + verifyDSIGN () (VerKeyEcdsaSecp256k1 pk) msg (SigEcdsaSecp256k1 sig) = if SECP.verifySig pk sig msg then pure () - else Left "SECP256k1 signature not verified" + else Left "ECDSA-SECP256k1 signature not verified" genKeyDSIGN seed = runMonadRandomWithSeed seed $ do bs <- getRandomBytes 32 case SECP.secKey bs of - Nothing -> error "Failed to construct a SECP256k1 secret key unexpectedly" - Just sk -> pure . SignKeySECP256k1 $ sk - rawSerialiseSigDSIGN (SigSECP256k1 sig) = putting sig - rawSerialiseVerKeyDSIGN (VerKeySECP256k1 pk) = putting pk - rawSerialiseSignKeyDSIGN (SignKeySECP256k1 sk) = putting sk - rawDeserialiseVerKeyDSIGN bs = VerKeySECP256k1 <$> (eitherToMaybe . getting $ bs) - rawDeserialiseSignKeyDSIGN bs = SignKeySECP256k1 <$> (eitherToMaybe . getting $ bs) - rawDeserialiseSigDSIGN bs = SigSECP256k1 <$> (eitherToMaybe . getting $ bs) - -instance ToCBOR (VerKeyDSIGN SECP256k1DSIGN) where + Nothing -> error "Failed to construct a ECDSA-SECP256k1 secret key unexpectedly" + Just sk -> pure . SignKeyEcdsaSecp256k1 $ sk + rawSerialiseSigDSIGN (SigEcdsaSecp256k1 sig) = putting sig + rawSerialiseVerKeyDSIGN (VerKeyEcdsaSecp256k1 pk) = putting pk + rawSerialiseSignKeyDSIGN (SignKeyEcdsaSecp256k1 sk) = putting sk + rawDeserialiseVerKeyDSIGN bs = + VerKeyEcdsaSecp256k1 <$> (eitherToMaybe . getting $ bs) + rawDeserialiseSignKeyDSIGN bs = + SignKeyEcdsaSecp256k1 <$> (eitherToMaybe . getting $ bs) + rawDeserialiseSigDSIGN bs = + SigEcdsaSecp256k1 <$> (eitherToMaybe . getting $ bs) + +instance ToCBOR (VerKeyDSIGN EcdsaSecp256k1DSIGN) where toCBOR = encodeVerKeyDSIGN encodedSizeExpr _ = encodedVerKeyDSIGNSizeExpr -instance FromCBOR (VerKeyDSIGN SECP256k1DSIGN) where +instance FromCBOR (VerKeyDSIGN EcdsaSecp256k1DSIGN) where fromCBOR = decodeVerKeyDSIGN -instance ToCBOR (SignKeyDSIGN SECP256k1DSIGN) where +instance ToCBOR (SignKeyDSIGN EcdsaSecp256k1DSIGN) where toCBOR = encodeSignKeyDSIGN encodedSizeExpr _ = encodedSignKeyDESIGNSizeExpr -instance FromCBOR (SignKeyDSIGN SECP256k1DSIGN) where +instance FromCBOR (SignKeyDSIGN EcdsaSecp256k1DSIGN) where fromCBOR = decodeSignKeyDSIGN -instance ToCBOR (SigDSIGN SECP256k1DSIGN) where +instance ToCBOR (SigDSIGN EcdsaSecp256k1DSIGN) where toCBOR = encodeSigDSIGN encodedSizeExpr _ = encodedSigDSIGNSizeExpr -instance FromCBOR (SigDSIGN SECP256k1DSIGN) where +instance FromCBOR (SigDSIGN EcdsaSecp256k1DSIGN) where fromCBOR = decodeSigDSIGN -- Required orphans diff --git a/cardano-crypto-tests/src/Test/Crypto/DSIGN.hs b/cardano-crypto-tests/src/Test/Crypto/DSIGN.hs index 92c0920d2..1cc092130 100644 --- a/cardano-crypto-tests/src/Test/Crypto/DSIGN.hs +++ b/cardano-crypto-tests/src/Test/Crypto/DSIGN.hs @@ -23,7 +23,7 @@ import Cardano.Crypto.DSIGN ( MockDSIGN, Ed25519DSIGN, Ed448DSIGN, - SECP256k1DSIGN, + EcdsaSecp256k1DSIGN, DSIGNAlgorithm (VerKeyDSIGN, SignKeyDSIGN, SigDSIGN, @@ -83,7 +83,7 @@ ed25519SigGen = defaultSigGen ed448SigGen :: Gen (SigDSIGN Ed448DSIGN) ed448SigGen = defaultSigGen -secp256k1SigGen :: Gen (SigDSIGN SECP256k1DSIGN) +secp256k1SigGen :: Gen (SigDSIGN EcdsaSecp256k1DSIGN) secp256k1SigGen = do msg <- genSECPMsg signDSIGN () msg <$> defaultSignKeyGen From 72f4266f2e4af49bb66c248debcbc0e400cd6f72 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Tue, 22 Feb 2022 10:58:46 +1300 Subject: [PATCH 08/13] Implement DSIGN interface for Schnorr signatures --- .../cardano-crypto-class.cabal | 227 ++++++++------- .../Cardano/Crypto/DSIGN/EcdsaSecp256k1.hs | 7 +- .../Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs | 268 ++++++++++++++++++ .../src/Cardano/Crypto/Schnorr.hs | 102 +++---- 4 files changed, 429 insertions(+), 175 deletions(-) create mode 100644 cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs diff --git a/cardano-crypto-class/cardano-crypto-class.cabal b/cardano-crypto-class/cardano-crypto-class.cabal index cd6c1d654..795c027bb 100644 --- a/cardano-crypto-class/cardano-crypto-class.cabal +++ b/cardano-crypto-class/cardano-crypto-class.cabal @@ -1,130 +1,127 @@ -cabal-version: 2.2 +cabal-version: 2.2 +name: cardano-crypto-class +version: 2.0.0 +synopsis: + Type classes abstracting over cryptography primitives for Cardano -name: cardano-crypto-class -version: 2.0.0 -synopsis: Type classes abstracting over cryptography primitives for Cardano -description: Type classes abstracting over cryptography primitives for Cardano -license: Apache-2.0 +description: + Type classes abstracting over cryptography primitives for Cardano + +license: Apache-2.0 license-files: LICENSE NOTICE -author: IOHK -maintainer: operations@iohk.io -copyright: 2019-2021 IOHK -category: Currency -build-type: Simple -extra-source-files: README.md + +author: IOHK +maintainer: operations@iohk.io +copyright: 2019-2021 IOHK +category: Currency +build-type: Simple +extra-source-files: README.md flag development - description: Disable `-Werror` - default: False - manual: True + description: Disable `-Werror` + default: False + manual: True -common base { build-depends: base >= 4.14 && < 4.15 } +common base + build-depends: base ^>=4.14 common project-config - default-language: Haskell2010 + default-language: Haskell2010 + ghc-options: + -Wall -Wcompat -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints + -Wunused-packages - ghc-options: -Wall - -Wcompat - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wpartial-fields - -Wredundant-constraints - -Wunused-packages - - if (!flag(development)) - ghc-options: -Werror + if !flag(development) + ghc-options: -Werror library - import: base, project-config - hs-source-dirs: src + import: base, project-config + hs-source-dirs: src exposed-modules: - Cardano.Crypto.DSIGN - Cardano.Crypto.Hash - Cardano.Crypto.KES - Cardano.Crypto.VRF - - Cardano.Crypto.DSIGN.Class - Cardano.Crypto.DSIGN.Ed25519 - Cardano.Crypto.DSIGN.Ed448 - Cardano.Crypto.DSIGN.Mock - Cardano.Crypto.DSIGN.NeverUsed - Cardano.Crypto.DSIGN.EcdsaSecp256k1 - - Cardano.Crypto.Hash.Blake2b - Cardano.Crypto.Hash.Class - Cardano.Crypto.Hash.NeverUsed - Cardano.Crypto.Hash.SHA256 - Cardano.Crypto.Hash.SHA3_256 - Cardano.Crypto.Hash.Short - Cardano.Crypto.Hash.Keccak256 - - Cardano.Crypto.KES.Class - Cardano.Crypto.KES.Mock - Cardano.Crypto.KES.NeverUsed - Cardano.Crypto.KES.Simple - Cardano.Crypto.KES.Single - Cardano.Crypto.KES.Sum - Cardano.Crypto.KES.CompactSingle - Cardano.Crypto.KES.CompactSum - - Cardano.Crypto.PinnedSizedBytes - Cardano.Crypto.Seed - Cardano.Crypto.Util - - Cardano.Crypto.VRF.Class - Cardano.Crypto.VRF.Mock - Cardano.Crypto.VRF.NeverUsed - Cardano.Crypto.VRF.Simple - - Cardano.Crypto.Libsodium - Cardano.Crypto.Libsodium.C - Cardano.Crypto.Libsodium.Constants - Cardano.Crypto.Libsodium.Hash - Cardano.Crypto.Libsodium.Init - Cardano.Crypto.Libsodium.Memory - Cardano.Crypto.Libsodium.Memory.Internal - Cardano.Crypto.Libsodium.MLockedBytes - Cardano.Crypto.Libsodium.MLockedBytes.Internal - Cardano.Crypto.Libsodium.UnsafeC - - Cardano.Foreign - - other-modules: Cardano.Crypto.PackedBytes - Cardano.Crypto.Schnorr - - build-depends: aeson - , base - , base16-bytestring >= 1 - , bytestring - , cardano-binary - , cardano-prelude - , cereal - , cryptonite - , deepseq - , integer-gmp - , ghc-prim - , memory - , nothunks - , primitive - , serialise - , secp256k1-haskell - , text - , transformers - , vector - - pkgconfig-depends: libsodium, libsecp256k1 + Cardano.Crypto.DSIGN + Cardano.Crypto.DSIGN.Class + Cardano.Crypto.DSIGN.EcdsaSecp256k1 + Cardano.Crypto.DSIGN.Ed25519 + Cardano.Crypto.DSIGN.Ed448 + Cardano.Crypto.DSIGN.Mock + Cardano.Crypto.DSIGN.NeverUsed + Cardano.Crypto.DSIGN.SchnorrSecp256k1 + Cardano.Crypto.Hash + Cardano.Crypto.Hash.Blake2b + Cardano.Crypto.Hash.Class + Cardano.Crypto.Hash.Keccak256 + Cardano.Crypto.Hash.NeverUsed + Cardano.Crypto.Hash.SHA256 + Cardano.Crypto.Hash.SHA3_256 + Cardano.Crypto.Hash.Short + Cardano.Crypto.KES + Cardano.Crypto.KES.Class + Cardano.Crypto.KES.CompactSingle + Cardano.Crypto.KES.CompactSum + Cardano.Crypto.KES.Mock + Cardano.Crypto.KES.NeverUsed + Cardano.Crypto.KES.Simple + Cardano.Crypto.KES.Single + Cardano.Crypto.KES.Sum + Cardano.Crypto.Libsodium + Cardano.Crypto.Libsodium.C + Cardano.Crypto.Libsodium.Constants + Cardano.Crypto.Libsodium.Hash + Cardano.Crypto.Libsodium.Init + Cardano.Crypto.Libsodium.Memory + Cardano.Crypto.Libsodium.Memory.Internal + Cardano.Crypto.Libsodium.MLockedBytes + Cardano.Crypto.Libsodium.MLockedBytes.Internal + Cardano.Crypto.Libsodium.UnsafeC + Cardano.Crypto.PinnedSizedBytes + Cardano.Crypto.Seed + Cardano.Crypto.Util + Cardano.Crypto.VRF + Cardano.Crypto.VRF.Class + Cardano.Crypto.VRF.Mock + Cardano.Crypto.VRF.NeverUsed + Cardano.Crypto.VRF.Simple + Cardano.Foreign + + other-modules: + Cardano.Crypto.PackedBytes + Cardano.Crypto.Schnorr + + build-depends: + , aeson + , base + , base16-bytestring >=1 + , bytestring + , cardano-binary + , cardano-prelude + , cereal + , cryptonite + , deepseq + , ghc-prim + , integer-gmp + , memory + , nothunks + , primitive + , secp256k1-haskell + , serialise + , text + , transformers + , vector + + pkgconfig-depends: libsodium -any, libsecp256k1 -any test-suite test-memory-example - import: base, project-config - type: exitcode-stdio-1.0 - hs-source-dirs: memory-example - main-is: Main.hs - - build-depends: base - , bytestring - , cardano-crypto-class - - if os(linux) || os(osx) - build-depends: unix + import: base, project-config + type: exitcode-stdio-1.0 + hs-source-dirs: memory-example + main-is: Main.hs + build-depends: + , base + , bytestring + , cardano-crypto-class + + if (os(linux) || os(osx)) + build-depends: unix diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/EcdsaSecp256k1.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/EcdsaSecp256k1.hs index 3162d4974..66a8dd8fd 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/EcdsaSecp256k1.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/EcdsaSecp256k1.hs @@ -8,7 +8,12 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-orphans #-} -- need NoThunks for secp256k1-haskell types -module Cardano.Crypto.DSIGN.EcdsaSecp256k1 where +module Cardano.Crypto.DSIGN.EcdsaSecp256k1 ( + EcdsaSecp256k1DSIGN, + VerKeyDSIGN (..), + SignKeyDSIGN (..), + SigDSIGN (..) + ) where import Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (toCBOR, encodedSizeExpr)) import Data.ByteString (ByteString) diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs new file mode 100644 index 000000000..13eef129a --- /dev/null +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs @@ -0,0 +1,268 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- According to the documentation for unsafePerformIO: +-- +-- > Make sure that the either you switch off let-floating +-- > (-fno-full-laziness), or that the call to unsafePerformIO cannot float +-- > outside a lambda. +-- +-- If we do not switch off let-floating, our calls to unsafeDupablePerformIO for +-- FFI functions become nondeterministic in their behaviour when run with +-- parallelism enabled (such as -with-rtsopts=-N), possibly yielding wrong +-- answers on a range of tasks, including serialization. +{-# OPTIONS_GHC -fno-full-laziness #-} + +module Cardano.Crypto.DSIGN.SchnorrSecp256k1 ( + SchnorrSecp256k1DSIGN, + VerKeyDSIGN, + SignKeyDSIGN, + SigDSIGN + ) where + +import qualified Data.ByteString as BS +import Data.ByteString.Unsafe (unsafePackCStringLen) +import Data.Primitive.Ptr (copyPtr) +import Crypto.Random (getRandomBytes) +import Cardano.Crypto.Seed (runMonadRandomWithSeed) +import Data.ByteString.Internal (toForeignPtr, memcmp) +import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, mallocForeignPtrBytes, + plusForeignPtr, castForeignPtr) +import Control.Monad (when) +import System.IO.Unsafe (unsafeDupablePerformIO, unsafePerformIO) +import Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (toCBOR, encodedSizeExpr)) +import Foreign.Ptr (Ptr, castPtr, nullPtr) +import Foreign.C.Types (CUChar) +import Foreign.Marshal.Alloc (allocaBytes) +import Cardano.Crypto.Schnorr (SECP256k1XOnlyPubKey, + secpKeyPairCreate, SECP256k1Context, secpKeyPairXOnlyPub, + SECP256k1SecKey, secpSchnorrSigVerify, secpContextSignVerify, + SECP256k1SchnorrSig, secpSchnorrSigSignCustom, secpContextCreate) +import NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (OnlyCheckWhnfNamed)) +import Cardano.Crypto.DSIGN.Class ( + DSIGNAlgorithm (VerKeyDSIGN, + SignKeyDSIGN, + SigDSIGN, + SeedSizeDSIGN, + SizeSigDSIGN, + SizeSignKeyDSIGN, + SizeVerKeyDSIGN, + algorithmNameDSIGN, + deriveVerKeyDSIGN, + signDSIGN, + verifyDSIGN, + genKeyDSIGN, + rawSerialiseSigDSIGN, + Signable, + rawSerialiseVerKeyDSIGN, + rawSerialiseSignKeyDSIGN, + rawDeserialiseVerKeyDSIGN, + rawDeserialiseSignKeyDSIGN, + rawDeserialiseSigDSIGN), + encodeVerKeyDSIGN, + encodedVerKeyDSIGNSizeExpr, + decodeVerKeyDSIGN, + encodeSignKeyDSIGN, + encodedSignKeyDESIGNSizeExpr, + decodeSignKeyDSIGN, + encodeSigDSIGN, + encodedSigDSIGNSizeExpr, + decodeSigDSIGN + ) +import Cardano.Crypto.Util (SignableRepresentation (getSignableRepresentation)) + +data SchnorrSecp256k1DSIGN + +instance DSIGNAlgorithm SchnorrSecp256k1DSIGN where + type SeedSizeDSIGN SchnorrSecp256k1DSIGN = 32 + type SizeSigDSIGN SchnorrSecp256k1DSIGN = 64 + type SizeSignKeyDSIGN SchnorrSecp256k1DSIGN = 32 + type SizeVerKeyDSIGN SchnorrSecp256k1DSIGN = 64 + type Signable SchnorrSecp256k1DSIGN = SignableRepresentation + newtype VerKeyDSIGN SchnorrSecp256k1DSIGN = + VerKeySchnorr256k1 (ForeignPtr SECP256k1XOnlyPubKey) + deriving NoThunks via (OnlyCheckWhnfNamed "VerKeySchnorr256k1" (ForeignPtr SECP256k1XOnlyPubKey)) + newtype SignKeyDSIGN SchnorrSecp256k1DSIGN = + SignKeySchnorr256k1 (ForeignPtr SECP256k1SecKey) + deriving NoThunks via (OnlyCheckWhnfNamed "SignKeySchnorr256k1" (ForeignPtr SECP256k1SecKey)) + newtype SigDSIGN SchnorrSecp256k1DSIGN = + SigSchnorr256k1 (ForeignPtr SECP256k1SchnorrSig) + deriving NoThunks via (OnlyCheckWhnfNamed "SigSchnorr256k1" (ForeignPtr SECP256k1SchnorrSig)) + algorithmNameDSIGN _ = "schnorr-secp256k1" + {-# NOINLINE deriveVerKeyDSIGN #-} + deriveVerKeyDSIGN (SignKeySchnorr256k1 fp) = + unsafeDupablePerformIO . withForeignPtr fp $ \skp -> do + let skp' :: Ptr CUChar = castPtr skp + allocaBytes 96 $ \kpp -> do + res <- secpKeyPairCreate ctxPtr kpp skp' + when (res /= 1) (error "deriveVerKeyDSIGN: Failed to create keypair") + xonlyFP <- mallocForeignPtrBytes 64 + res' <- withForeignPtr xonlyFP $ \xonlyp -> + secpKeyPairXOnlyPub ctxPtr xonlyp nullPtr kpp + when (res' /= 1) (error "deriveVerKeyDSIGN: could not extract xonly pubkey") + pure . VerKeySchnorr256k1 $ xonlyFP + {-# NOINLINE signDSIGN #-} + signDSIGN () msg (SignKeySchnorr256k1 skfp) = + unsafeDupablePerformIO . withForeignPtr skfp $ \skp -> do + let bs = getSignableRepresentation msg + let skp' :: Ptr CUChar = castPtr skp + allocaBytes 96 $ \kpp -> do + res <- secpKeyPairCreate ctxPtr kpp skp' + when (res /= 1) (error "signDSIGN: Failed to create keypair") + sigFP <- mallocForeignPtrBytes 64 + let (msgFP, msgOff, msgLen) = toForeignPtr bs + res' <- withForeignPtr sigFP $ \sigp -> + withForeignPtr (plusForeignPtr msgFP msgOff) $ \msgp -> + secpSchnorrSigSignCustom ctxPtr + sigp + (castPtr msgp) + (fromIntegral msgLen) + kpp + nullPtr + when (res' /= 1) (error "signDSIGN: Failed to sign message") + pure . SigSchnorr256k1 $ sigFP + {-# NOINLINE verifyDSIGN #-} + verifyDSIGN () (VerKeySchnorr256k1 pubkeyFP) msg (SigSchnorr256k1 sigFP) = + unsafeDupablePerformIO . withForeignPtr pubkeyFP $ \pkp -> + withForeignPtr sigFP $ \sigp -> do + let bs = getSignableRepresentation msg + let (msgFP, msgOff, msgLen) = toForeignPtr bs + let sigp' :: Ptr CUChar = castPtr sigp + res <- withForeignPtr (plusForeignPtr msgFP msgOff) $ \msgp -> + pure . + secpSchnorrSigVerify ctxPtr sigp' (castPtr msgp) (fromIntegral msgLen) $ pkp + pure $ if res == 0 + then Left "Schnorr signature failed to verify." + else pure () + {-# NOINLINE genKeyDSIGN #-} + genKeyDSIGN seed = runMonadRandomWithSeed seed $ do + bs <- getRandomBytes 32 + unsafeDupablePerformIO $ do + let (bsFP, bsOff, _) = toForeignPtr bs + fp <- withForeignPtr (plusForeignPtr bsFP bsOff) $ \bsp -> do + skFP <- mallocForeignPtrBytes 64 + withForeignPtr skFP $ \skp -> do + let skp' :: Ptr CUChar = castPtr skp + let bsp' :: Ptr CUChar = castPtr bsp + copyPtr skp' bsp' 64 + pure skFP + pure . pure . SignKeySchnorr256k1 $ fp + {-# NOINLINE rawSerialiseSigDSIGN #-} + rawSerialiseSigDSIGN (SigSchnorr256k1 sigFP) = + unsafeDupablePerformIO . withForeignPtr sigFP $ \sigp -> + unsafePackCStringLen (castPtr sigp, 64) + {-# NOINLINE rawSerialiseVerKeyDSIGN #-} + rawSerialiseVerKeyDSIGN (VerKeySchnorr256k1 vkFP) = + unsafeDupablePerformIO . withForeignPtr vkFP $ \vkp -> + unsafePackCStringLen (castPtr vkp, 64) + {-# NOINLINE rawSerialiseSignKeyDSIGN #-} + rawSerialiseSignKeyDSIGN (SignKeySchnorr256k1 skFP) = + unsafeDupablePerformIO . withForeignPtr skFP $ \skp -> + unsafePackCStringLen (castPtr skp, 32) + rawDeserialiseVerKeyDSIGN bs + | BS.length bs == 64 = + let (bsFP, bsOff, _) = toForeignPtr bs in + pure . VerKeySchnorr256k1 . castForeignPtr . plusForeignPtr bsFP $ bsOff + | otherwise = Nothing + rawDeserialiseSignKeyDSIGN bs + | BS.length bs == 32 = + let (bsFP, bsOff, _) = toForeignPtr bs in + pure . SignKeySchnorr256k1 . castForeignPtr . plusForeignPtr bsFP $ bsOff + | otherwise = Nothing + rawDeserialiseSigDSIGN bs + | BS.length bs == 64 = + let (bsFP, bsOff, _) = toForeignPtr bs in + pure . SigSchnorr256k1 . castForeignPtr . plusForeignPtr bsFP $ bsOff + | otherwise = Nothing + +instance Eq (VerKeyDSIGN SchnorrSecp256k1DSIGN) where + {-# NOINLINE (==) #-} + VerKeySchnorr256k1 fp == VerKeySchnorr256k1 fp' = + unsafeDupablePerformIO . withForeignPtr fp $ \p -> + withForeignPtr fp' $ \p' -> do + res <- memcmp (castPtr p) (castPtr p') 64 + pure $ case res of + 0 -> True + _ -> False + +instance Eq (SignKeyDSIGN SchnorrSecp256k1DSIGN) where + {-# NOINLINE (==) #-} + SignKeySchnorr256k1 fp == SignKeySchnorr256k1 fp' = + unsafeDupablePerformIO . withForeignPtr fp $ \p -> + withForeignPtr fp' $ \p' -> do + res <- memcmp (castPtr p) (castPtr p') 32 + pure $ case res of + 0 -> True + _ -> False + +instance Eq (SigDSIGN SchnorrSecp256k1DSIGN) where + {-# NOINLINE (==) #-} + SigSchnorr256k1 fp == SigSchnorr256k1 fp' = + unsafeDupablePerformIO . withForeignPtr fp $ \p -> + withForeignPtr fp' $ \p' -> do + res <- memcmp (castPtr p) (castPtr p') 64 + pure $ case res of + 0 -> True + _ -> False + +instance Show (VerKeyDSIGN SchnorrSecp256k1DSIGN) where + {-# NOINLINE show #-} + show (VerKeySchnorr256k1 fp) = + ("VerKeySchnorr256k1 " <>) . + show . + unsafeDupablePerformIO . + withForeignPtr fp $ \p -> + unsafePackCStringLen (castPtr p, 64) + +instance Show (SignKeyDSIGN SchnorrSecp256k1DSIGN) where + {-# NOINLINE show #-} + show (SignKeySchnorr256k1 fp) = + ("SignKeySchnorr256k1 " <>) . + show . + unsafeDupablePerformIO . + withForeignPtr fp $ \p -> + unsafePackCStringLen (castPtr p, 32) + +instance Show (SigDSIGN SchnorrSecp256k1DSIGN) where + {-# NOINLINE show #-} + show (SigSchnorr256k1 fp) = + ("SigSchnorr256k1 " <>) . + show . + unsafeDupablePerformIO . + withForeignPtr fp $ \p -> + unsafePackCStringLen (castPtr p, 64) + +instance ToCBOR (VerKeyDSIGN SchnorrSecp256k1DSIGN) where + toCBOR = encodeVerKeyDSIGN + encodedSizeExpr _ = encodedVerKeyDSIGNSizeExpr + +instance FromCBOR (VerKeyDSIGN SchnorrSecp256k1DSIGN) where + fromCBOR = decodeVerKeyDSIGN + +instance ToCBOR (SignKeyDSIGN SchnorrSecp256k1DSIGN) where + toCBOR = encodeSignKeyDSIGN + encodedSizeExpr _ = encodedSignKeyDESIGNSizeExpr + +instance FromCBOR (SignKeyDSIGN SchnorrSecp256k1DSIGN) where + fromCBOR = decodeSignKeyDSIGN + +instance ToCBOR (SigDSIGN SchnorrSecp256k1DSIGN) where + toCBOR = encodeSigDSIGN + encodedSizeExpr _ = encodedSigDSIGNSizeExpr + +instance FromCBOR (SigDSIGN SchnorrSecp256k1DSIGN) where + fromCBOR = decodeSigDSIGN + +-- Helpers + +-- We follow the lead of secp256k1-haskell by creating (once) a context for both +-- signing and verification which we use everywhere, but do not export. This +-- saves considerable time, and is safe, provided nobody else gets to touch it. +-- +-- We do _not_ make this dupable, as the whole point is _not_ to compute it more +-- than once! +{-# NOINLINE ctxPtr #-} +ctxPtr :: Ptr SECP256k1Context +ctxPtr = unsafePerformIO . secpContextCreate $ secpContextSignVerify diff --git a/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs b/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs index 5874173ee..199fc10f6 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs @@ -5,27 +5,23 @@ module Cardano.Crypto.Schnorr ( schnorrNonceFunction, SECP256k1Context, --- secpContextNoPrecomp, + secpContextSignVerify, + SECP256k1SchnorrExtraParams, + SECP256k1SecKey, + SECP256k1SchnorrSig, secpContextCreate, secpContextDestroy, SECP256k1KeyPair, secpKeyPairCreate, secpSchnorrSigSign, + secpSchnorrSigSignCustom, SECP256k1XOnlyPubKey, + secpKeyPairXOnlyPub, secpSchnorrSigVerify, ) where -import Data.Primitive.Ptr (copyPtr) -import Data.Word (Word8) -import Data.Primitive.ByteArray ( - ByteArray, - newAlignedPinnedByteArray, - byteArrayContents, - mutableByteArrayContents, - unsafeFreezeByteArray, - ) -import Foreign.Storable (Storable (sizeOf, alignment, peek, poke)) -import Foreign.Ptr (Ptr, castPtr) +import Data.Bits ((.|.)) +import Foreign.Ptr (Ptr) import Foreign.C.Types (CUChar, CSize (CSize), CInt (CInt)) foreign import capi "secp256k1_schnorrsig.h secp256k1_nonce_function_bip340" @@ -42,10 +38,7 @@ foreign import capi "secp256k1_schnorrsig.h secp256k1_nonce_function_bip340" data SECP256k1Context -{- -foreign import capi "secp256k1.h value secp256k1_context_no_precomp" - secpContextNoPrecomp :: Ptr SECP256k1Context --} +data SECP256k1SchnorrExtraParams foreign import capi "secp256k1.h secp256k1_context_create" secpContextCreate :: @@ -57,27 +50,20 @@ foreign import capi "secp256k1.h secp256k1_context_destroy" Ptr SECP256k1Context -> IO () -newtype SECP256k1KeyPair = SECP256k1KeyPair ByteArray - deriving (Eq, Ord) via ByteArray - deriving stock (Show) - -instance Storable SECP256k1KeyPair where - {-# INLINEABLE sizeOf #-} - sizeOf _ = 96 - {-# INLINEABLE alignment #-} - alignment _ = 96 - {-# INLINEABLE peek #-} - peek p = do - let pBytes :: Ptr Word8 = castPtr p - mba <- newAlignedPinnedByteArray 96 96 - let mbaPtr = mutableByteArrayContents mba - copyPtr mbaPtr pBytes 96 - SECP256k1KeyPair <$> unsafeFreezeByteArray mba - {-# INLINEABLE poke #-} - poke p (SECP256k1KeyPair ba) = do - let pBytes :: Ptr Word8 = castPtr p - let baPtr = byteArrayContents ba - copyPtr pBytes baPtr 96 +foreign import capi "secp256k1.h SECP256k1_CONTEXT_SIGN" + secpContextSign :: CInt + +foreign import capi "secp256k1.h SECP256k1_CONTEXT_VERIFY" + secpContextVerify :: CInt + +secpContextSignVerify :: CInt +secpContextSignVerify = secpContextSign .|. secpContextVerify + +data SECP256k1SecKey + +data SECP256k1SchnorrSig + +data SECP256k1KeyPair foreign import capi "secp256k1_extrakeys.h secp256k1_keypair_create" secpKeyPairCreate :: @@ -89,33 +75,31 @@ foreign import capi "secp256k1_extrakeys.h secp256k1_keypair_create" foreign import capi "secp256k1_schnorrsig.h secp256k1_schnorrsig_sign" secpSchnorrSigSign :: Ptr SECP256k1Context -- context initialized for signing - -> Ptr CUChar -- out-param for signature (64 bytes) + -> Ptr SECP256k1SchnorrSig -- out-param for signature (64 bytes) -> Ptr CUChar -- message hash to sign (32 bytes) -> Ptr SECP256k1KeyPair -- initialized keypair -> Ptr CUChar -- fresh randomness (32 bytes) -> IO CInt -- 1 on success, 0 on failure -newtype SECP256k1XOnlyPubKey = SECP256k1XOnlyPubKey ByteArray - deriving (Eq, Ord) via ByteArray - deriving stock (Show) - -instance Storable SECP256k1XOnlyPubKey where - {-# INLINEABLE sizeOf #-} - sizeOf _ = 64 - {-# INLINEABLE alignment #-} - alignment _ = 64 - {-# INLINEABLE peek #-} - peek p = do - let pBytes :: Ptr Word8 = castPtr p - mba <- newAlignedPinnedByteArray 64 64 - let mbaPtr = mutableByteArrayContents mba - copyPtr mbaPtr pBytes 64 - SECP256k1XOnlyPubKey <$> unsafeFreezeByteArray mba - {-# INLINEABLE poke #-} - poke p (SECP256k1XOnlyPubKey ba) = do - let pBytes :: Ptr Word8 = castPtr p - let baPtr = byteArrayContents ba - copyPtr pBytes baPtr 64 +foreign import capi "secp256k1_schnorrsig.h secp256k1_schnorrsig_sign_custom" + secpSchnorrSigSignCustom :: + Ptr SECP256k1Context -- context initialized for signing + -> Ptr SECP256k1SchnorrSig -- out-param for signature (64 bytes) + -> Ptr CUChar -- message to sign + -> CSize -- message length in bytes + -> Ptr SECP256k1KeyPair -- initialized keypair + -> Ptr SECP256k1SchnorrExtraParams -- not used + -> IO CInt -- 1 on success, 0 on failure + +data SECP256k1XOnlyPubKey + +foreign import capi "secp256k1_extrakeys.h secp256k1_keypair_xonly_pub" + secpKeyPairXOnlyPub :: + Ptr SECP256k1Context -- an initialized context + -> Ptr SECP256k1XOnlyPubKey -- out-param for xonly pubkey + -> Ptr CInt -- parity (not used) + -> Ptr SECP256k1KeyPair -- keypair + -> IO CInt -- 1 on success, 0 on error foreign import capi "secp256k1_schnorrsig.h secp256k1_schnorrsig_verify" secpSchnorrSigVerify :: From 2bfa4d8957593e9f6e99083111e03bb16b717786 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Tue, 22 Feb 2022 11:09:30 +1300 Subject: [PATCH 09/13] Add to test suite, ensure everything passes --- .../src/Cardano/Crypto/DSIGN.hs | 1 + .../Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs | 52 ++++++++++++++----- .../src/Cardano/Crypto/Schnorr.hs | 27 +--------- cardano-crypto-tests/src/Test/Crypto/DSIGN.hs | 7 ++- 4 files changed, 49 insertions(+), 38 deletions(-) diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN.hs index 8ef74a1fc..9eeeaf73e 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN.hs @@ -10,3 +10,4 @@ import Cardano.Crypto.DSIGN.Ed448 as X import Cardano.Crypto.DSIGN.Mock as X import Cardano.Crypto.DSIGN.NeverUsed as X import Cardano.Crypto.DSIGN.EcdsaSecp256k1 as X +import Cardano.Crypto.DSIGN.SchnorrSecp256k1 as X diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs index 13eef129a..7fe792a90 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs @@ -28,18 +28,31 @@ import Data.Primitive.Ptr (copyPtr) import Crypto.Random (getRandomBytes) import Cardano.Crypto.Seed (runMonadRandomWithSeed) import Data.ByteString.Internal (toForeignPtr, memcmp) -import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, mallocForeignPtrBytes, - plusForeignPtr, castForeignPtr) +import Foreign.ForeignPtr ( + ForeignPtr, + withForeignPtr, + mallocForeignPtrBytes, + plusForeignPtr, + castForeignPtr + ) import Control.Monad (when) import System.IO.Unsafe (unsafeDupablePerformIO, unsafePerformIO) import Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (toCBOR, encodedSizeExpr)) import Foreign.Ptr (Ptr, castPtr, nullPtr) import Foreign.C.Types (CUChar) import Foreign.Marshal.Alloc (allocaBytes) -import Cardano.Crypto.Schnorr (SECP256k1XOnlyPubKey, - secpKeyPairCreate, SECP256k1Context, secpKeyPairXOnlyPub, - SECP256k1SecKey, secpSchnorrSigVerify, secpContextSignVerify, - SECP256k1SchnorrSig, secpSchnorrSigSignCustom, secpContextCreate) +import Cardano.Crypto.Schnorr ( + SECP256k1XOnlyPubKey, + secpKeyPairCreate, + SECP256k1Context, + secpKeyPairXOnlyPub, + SECP256k1SecKey, + secpSchnorrSigVerify, + secpContextSignVerify, + SECP256k1SchnorrSig, + secpSchnorrSigSignCustom, + secpContextCreate + ) import NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (OnlyCheckWhnfNamed)) import Cardano.Crypto.DSIGN.Class ( DSIGNAlgorithm (VerKeyDSIGN, @@ -83,13 +96,19 @@ instance DSIGNAlgorithm SchnorrSecp256k1DSIGN where type Signable SchnorrSecp256k1DSIGN = SignableRepresentation newtype VerKeyDSIGN SchnorrSecp256k1DSIGN = VerKeySchnorr256k1 (ForeignPtr SECP256k1XOnlyPubKey) - deriving NoThunks via (OnlyCheckWhnfNamed "VerKeySchnorr256k1" (ForeignPtr SECP256k1XOnlyPubKey)) + deriving NoThunks via ( + OnlyCheckWhnfNamed "VerKeySchnorr256k1" (ForeignPtr SECP256k1XOnlyPubKey) + ) newtype SignKeyDSIGN SchnorrSecp256k1DSIGN = SignKeySchnorr256k1 (ForeignPtr SECP256k1SecKey) - deriving NoThunks via (OnlyCheckWhnfNamed "SignKeySchnorr256k1" (ForeignPtr SECP256k1SecKey)) + deriving NoThunks via ( + OnlyCheckWhnfNamed "SignKeySchnorr256k1" (ForeignPtr SECP256k1SecKey) + ) newtype SigDSIGN SchnorrSecp256k1DSIGN = SigSchnorr256k1 (ForeignPtr SECP256k1SchnorrSig) - deriving NoThunks via (OnlyCheckWhnfNamed "SigSchnorr256k1" (ForeignPtr SECP256k1SchnorrSig)) + deriving NoThunks via ( + OnlyCheckWhnfNamed "SigSchnorr256k1" (ForeignPtr SECP256k1SchnorrSig) + ) algorithmNameDSIGN _ = "schnorr-secp256k1" {-# NOINLINE deriveVerKeyDSIGN #-} deriveVerKeyDSIGN (SignKeySchnorr256k1 fp) = @@ -164,17 +183,26 @@ instance DSIGNAlgorithm SchnorrSecp256k1DSIGN where rawDeserialiseVerKeyDSIGN bs | BS.length bs == 64 = let (bsFP, bsOff, _) = toForeignPtr bs in - pure . VerKeySchnorr256k1 . castForeignPtr . plusForeignPtr bsFP $ bsOff + pure . + VerKeySchnorr256k1 . + castForeignPtr . + plusForeignPtr bsFP $ bsOff | otherwise = Nothing rawDeserialiseSignKeyDSIGN bs | BS.length bs == 32 = let (bsFP, bsOff, _) = toForeignPtr bs in - pure . SignKeySchnorr256k1 . castForeignPtr . plusForeignPtr bsFP $ bsOff + pure . + SignKeySchnorr256k1 . + castForeignPtr . + plusForeignPtr bsFP $ bsOff | otherwise = Nothing rawDeserialiseSigDSIGN bs | BS.length bs == 64 = let (bsFP, bsOff, _) = toForeignPtr bs in - pure . SigSchnorr256k1 . castForeignPtr . plusForeignPtr bsFP $ bsOff + pure . + SigSchnorr256k1 . + castForeignPtr . + plusForeignPtr bsFP $ bsOff | otherwise = Nothing instance Eq (VerKeyDSIGN SchnorrSecp256k1DSIGN) where diff --git a/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs b/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs index 199fc10f6..f23f5cf86 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/Schnorr.hs @@ -3,7 +3,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module Cardano.Crypto.Schnorr ( - schnorrNonceFunction, SECP256k1Context, secpContextSignVerify, SECP256k1SchnorrExtraParams, @@ -13,7 +12,6 @@ module Cardano.Crypto.Schnorr ( secpContextDestroy, SECP256k1KeyPair, secpKeyPairCreate, - secpSchnorrSigSign, secpSchnorrSigSignCustom, SECP256k1XOnlyPubKey, secpKeyPairXOnlyPub, @@ -24,18 +22,6 @@ import Data.Bits ((.|.)) import Foreign.Ptr (Ptr) import Foreign.C.Types (CUChar, CSize (CSize), CInt (CInt)) -foreign import capi "secp256k1_schnorrsig.h secp256k1_nonce_function_bip340" - schnorrNonceFunction :: - Ptr CUChar -- out-param for nonce (32 bytes) - -> Ptr CUChar -- message being verified, only NULL when message length is 0 - -> CSize -- message length - -> Ptr CUChar -- secret key (not NULL, 32 bytes) - -> Ptr CUChar -- serialized xonly pubkey corresponding to secret key (not NULL, 32 bytes) - -> Ptr CUChar -- description of algorithm (not NULL) - -> CSize -- length of algorithm description - -> Ptr CUChar -- arbitrary passthrough data - -> IO CInt -- 1 on success, 0 on error - data SECP256k1Context data SECP256k1SchnorrExtraParams @@ -50,10 +36,10 @@ foreign import capi "secp256k1.h secp256k1_context_destroy" Ptr SECP256k1Context -> IO () -foreign import capi "secp256k1.h SECP256k1_CONTEXT_SIGN" +foreign import capi "secp256k1.h value SECP256K1_CONTEXT_SIGN" secpContextSign :: CInt -foreign import capi "secp256k1.h SECP256k1_CONTEXT_VERIFY" +foreign import capi "secp256k1.h value SECP256K1_CONTEXT_VERIFY" secpContextVerify :: CInt secpContextSignVerify :: CInt @@ -72,15 +58,6 @@ foreign import capi "secp256k1_extrakeys.h secp256k1_keypair_create" -> Ptr CUChar -- secret key (32 bytes) -> IO CInt -- 1 on success, 0 on failure -foreign import capi "secp256k1_schnorrsig.h secp256k1_schnorrsig_sign" - secpSchnorrSigSign :: - Ptr SECP256k1Context -- context initialized for signing - -> Ptr SECP256k1SchnorrSig -- out-param for signature (64 bytes) - -> Ptr CUChar -- message hash to sign (32 bytes) - -> Ptr SECP256k1KeyPair -- initialized keypair - -> Ptr CUChar -- fresh randomness (32 bytes) - -> IO CInt -- 1 on success, 0 on failure - foreign import capi "secp256k1_schnorrsig.h secp256k1_schnorrsig_sign_custom" secpSchnorrSigSignCustom :: Ptr SECP256k1Context -- context initialized for signing diff --git a/cardano-crypto-tests/src/Test/Crypto/DSIGN.hs b/cardano-crypto-tests/src/Test/Crypto/DSIGN.hs index 1cc092130..993646544 100644 --- a/cardano-crypto-tests/src/Test/Crypto/DSIGN.hs +++ b/cardano-crypto-tests/src/Test/Crypto/DSIGN.hs @@ -24,6 +24,7 @@ import Cardano.Crypto.DSIGN ( Ed25519DSIGN, Ed448DSIGN, EcdsaSecp256k1DSIGN, + SchnorrSecp256k1DSIGN, DSIGNAlgorithm (VerKeyDSIGN, SignKeyDSIGN, SigDSIGN, @@ -88,6 +89,9 @@ secp256k1SigGen = do msg <- genSECPMsg signDSIGN () msg <$> defaultSignKeyGen +schnorrSigGen :: Gen (SigDSIGN SchnorrSecp256k1DSIGN) +schnorrSigGen = defaultSigGen + genSECPMsg :: Gen SECP.Msg genSECPMsg = Gen.suchThatMap go SECP.msg where @@ -122,7 +126,8 @@ tests = [ testDSIGNAlgorithm mockSigGen (arbitrary @Message) "MockDSIGN" , testDSIGNAlgorithm ed25519SigGen (arbitrary @Message) "Ed25519DSIGN" , testDSIGNAlgorithm ed448SigGen (arbitrary @Message) "Ed448DSIGN" - , testDSIGNAlgorithm secp256k1SigGen genSECPMsg "SECP-256k1" + , testDSIGNAlgorithm secp256k1SigGen genSECPMsg "EcdsaSecp256k1DSIGN" + , testDSIGNAlgorithm schnorrSigGen (arbitrary @Message) "SchnorrSecp256k1DSIGN" ] testDSIGNAlgorithm :: forall (v :: Type) (a :: Type). From 7436983e117a77d8a7cbb9db09bc2933ba466200 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Mon, 28 Feb 2022 13:14:32 +1300 Subject: [PATCH 10/13] Rewrite Schnorr implementation with PinnedByteArray --- .../Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs | 227 ++++++------------ 1 file changed, 72 insertions(+), 155 deletions(-) diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs index 7fe792a90..f699b6957 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs @@ -3,6 +3,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} -- According to the documentation for unsafePerformIO: -- -- > Make sure that the either you switch off let-floating @@ -22,19 +25,13 @@ module Cardano.Crypto.DSIGN.SchnorrSecp256k1 ( SigDSIGN ) where -import qualified Data.ByteString as BS -import Data.ByteString.Unsafe (unsafePackCStringLen) +import GHC.Generics (Generic) +import Control.DeepSeq (NFData) import Data.Primitive.Ptr (copyPtr) import Crypto.Random (getRandomBytes) import Cardano.Crypto.Seed (runMonadRandomWithSeed) -import Data.ByteString.Internal (toForeignPtr, memcmp) -import Foreign.ForeignPtr ( - ForeignPtr, - withForeignPtr, - mallocForeignPtrBytes, - plusForeignPtr, - castForeignPtr - ) +import Data.ByteString.Internal (toForeignPtr) +import Foreign.ForeignPtr (withForeignPtr, plusForeignPtr) import Control.Monad (when) import System.IO.Unsafe (unsafeDupablePerformIO, unsafePerformIO) import Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (toCBOR, encodedSizeExpr)) @@ -42,18 +39,15 @@ import Foreign.Ptr (Ptr, castPtr, nullPtr) import Foreign.C.Types (CUChar) import Foreign.Marshal.Alloc (allocaBytes) import Cardano.Crypto.Schnorr ( - SECP256k1XOnlyPubKey, secpKeyPairCreate, SECP256k1Context, secpKeyPairXOnlyPub, - SECP256k1SecKey, secpSchnorrSigVerify, secpContextSignVerify, - SECP256k1SchnorrSig, secpSchnorrSigSignCustom, secpContextCreate ) -import NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (OnlyCheckWhnfNamed)) +import NoThunks.Class (NoThunks) import Cardano.Crypto.DSIGN.Class ( DSIGNAlgorithm (VerKeyDSIGN, SignKeyDSIGN, @@ -85,6 +79,13 @@ import Cardano.Crypto.DSIGN.Class ( decodeSigDSIGN ) import Cardano.Crypto.Util (SignableRepresentation (getSignableRepresentation)) +import Cardano.Crypto.PinnedSizedBytes ( + PinnedSizedBytes, + psbUseAsCPtr, + psbCreate, + psbToByteString, + psbFromByteStringCheck, + ) data SchnorrSecp256k1DSIGN @@ -94,64 +95,68 @@ instance DSIGNAlgorithm SchnorrSecp256k1DSIGN where type SizeSignKeyDSIGN SchnorrSecp256k1DSIGN = 32 type SizeVerKeyDSIGN SchnorrSecp256k1DSIGN = 64 type Signable SchnorrSecp256k1DSIGN = SignableRepresentation - newtype VerKeyDSIGN SchnorrSecp256k1DSIGN = - VerKeySchnorr256k1 (ForeignPtr SECP256k1XOnlyPubKey) - deriving NoThunks via ( - OnlyCheckWhnfNamed "VerKeySchnorr256k1" (ForeignPtr SECP256k1XOnlyPubKey) - ) - newtype SignKeyDSIGN SchnorrSecp256k1DSIGN = - SignKeySchnorr256k1 (ForeignPtr SECP256k1SecKey) - deriving NoThunks via ( - OnlyCheckWhnfNamed "SignKeySchnorr256k1" (ForeignPtr SECP256k1SecKey) - ) - newtype SigDSIGN SchnorrSecp256k1DSIGN = - SigSchnorr256k1 (ForeignPtr SECP256k1SchnorrSig) - deriving NoThunks via ( - OnlyCheckWhnfNamed "SigSchnorr256k1" (ForeignPtr SECP256k1SchnorrSig) - ) + newtype VerKeyDSIGN SchnorrSecp256k1DSIGN = + VerKeySchnorr256k1 (PinnedSizedBytes (SizeVerKeyDSIGN SchnorrSecp256k1DSIGN)) + deriving newtype (Eq, NFData) + deriving stock (Show, Generic) + deriving anyclass (NoThunks) + newtype SignKeyDSIGN SchnorrSecp256k1DSIGN = + SignKeySchnorr256k1 (PinnedSizedBytes (SizeSignKeyDSIGN SchnorrSecp256k1DSIGN)) + deriving newtype (Eq, NFData) + deriving stock (Show, Generic) + deriving anyclass (NoThunks) + newtype SigDSIGN SchnorrSecp256k1DSIGN = + SigSchnorr256k1 (PinnedSizedBytes (SizeSigDSIGN SchnorrSecp256k1DSIGN)) + deriving newtype (Eq, NFData) + deriving stock (Show, Generic) + deriving anyclass (NoThunks) algorithmNameDSIGN _ = "schnorr-secp256k1" {-# NOINLINE deriveVerKeyDSIGN #-} - deriveVerKeyDSIGN (SignKeySchnorr256k1 fp) = - unsafeDupablePerformIO . withForeignPtr fp $ \skp -> do + deriveVerKeyDSIGN (SignKeySchnorr256k1 psb) = + unsafeDupablePerformIO . psbUseAsCPtr psb $ \skp -> do let skp' :: Ptr CUChar = castPtr skp allocaBytes 96 $ \kpp -> do res <- secpKeyPairCreate ctxPtr kpp skp' when (res /= 1) (error "deriveVerKeyDSIGN: Failed to create keypair") - xonlyFP <- mallocForeignPtrBytes 64 - res' <- withForeignPtr xonlyFP $ \xonlyp -> - secpKeyPairXOnlyPub ctxPtr xonlyp nullPtr kpp - when (res' /= 1) (error "deriveVerKeyDSIGN: could not extract xonly pubkey") - pure . VerKeySchnorr256k1 $ xonlyFP + xonlyPSB <- psbCreate $ \xonlyp -> do + res' <- secpKeyPairXOnlyPub ctxPtr (castPtr xonlyp) nullPtr kpp + when (res' /= 1) + (error "deriveVerKeyDsIGN: could not extract xonly pubkey") + pure . VerKeySchnorr256k1 $ xonlyPSB {-# NOINLINE signDSIGN #-} - signDSIGN () msg (SignKeySchnorr256k1 skfp) = - unsafeDupablePerformIO . withForeignPtr skfp $ \skp -> do + signDSIGN () msg (SignKeySchnorr256k1 skpsb) = + unsafeDupablePerformIO . psbUseAsCPtr skpsb $ \skp -> do let bs = getSignableRepresentation msg let skp' :: Ptr CUChar = castPtr skp allocaBytes 96 $ \kpp -> do res <- secpKeyPairCreate ctxPtr kpp skp' when (res /= 1) (error "signDSIGN: Failed to create keypair") - sigFP <- mallocForeignPtrBytes 64 let (msgFP, msgOff, msgLen) = toForeignPtr bs - res' <- withForeignPtr sigFP $ \sigp -> - withForeignPtr (plusForeignPtr msgFP msgOff) $ \msgp -> - secpSchnorrSigSignCustom ctxPtr - sigp - (castPtr msgp) - (fromIntegral msgLen) - kpp - nullPtr - when (res' /= 1) (error "signDSIGN: Failed to sign message") - pure . SigSchnorr256k1 $ sigFP + sigPSB <- psbCreate $ \sigp -> + withForeignPtr (plusForeignPtr msgFP msgOff) $ \msgp -> do + res' <- secpSchnorrSigSignCustom ctxPtr + (castPtr sigp) + (castPtr msgp) + (fromIntegral msgLen) + kpp + nullPtr + when (res' /= 1) + (error "signDSIGN: Failed to sign message") + pure . SigSchnorr256k1 $ sigPSB {-# NOINLINE verifyDSIGN #-} - verifyDSIGN () (VerKeySchnorr256k1 pubkeyFP) msg (SigSchnorr256k1 sigFP) = - unsafeDupablePerformIO . withForeignPtr pubkeyFP $ \pkp -> - withForeignPtr sigFP $ \sigp -> do + verifyDSIGN () (VerKeySchnorr256k1 pubkeyPSB) msg (SigSchnorr256k1 sigPSB) = + unsafeDupablePerformIO . psbUseAsCPtr pubkeyPSB $ \pkp -> + psbUseAsCPtr sigPSB $ \sigp -> do let bs = getSignableRepresentation msg let (msgFP, msgOff, msgLen) = toForeignPtr bs let sigp' :: Ptr CUChar = castPtr sigp res <- withForeignPtr (plusForeignPtr msgFP msgOff) $ \msgp -> - pure . - secpSchnorrSigVerify ctxPtr sigp' (castPtr msgp) (fromIntegral msgLen) $ pkp + pure $ + secpSchnorrSigVerify ctxPtr + sigp' + (castPtr msgp) + (fromIntegral msgLen) + (castPtr pkp) pure $ if res == 0 then Left "Schnorr signature failed to verify." else pure () @@ -160,107 +165,19 @@ instance DSIGNAlgorithm SchnorrSecp256k1DSIGN where bs <- getRandomBytes 32 unsafeDupablePerformIO $ do let (bsFP, bsOff, _) = toForeignPtr bs - fp <- withForeignPtr (plusForeignPtr bsFP bsOff) $ \bsp -> do - skFP <- mallocForeignPtrBytes 64 - withForeignPtr skFP $ \skp -> do - let skp' :: Ptr CUChar = castPtr skp - let bsp' :: Ptr CUChar = castPtr bsp - copyPtr skp' bsp' 64 - pure skFP - pure . pure . SignKeySchnorr256k1 $ fp - {-# NOINLINE rawSerialiseSigDSIGN #-} - rawSerialiseSigDSIGN (SigSchnorr256k1 sigFP) = - unsafeDupablePerformIO . withForeignPtr sigFP $ \sigp -> - unsafePackCStringLen (castPtr sigp, 64) - {-# NOINLINE rawSerialiseVerKeyDSIGN #-} - rawSerialiseVerKeyDSIGN (VerKeySchnorr256k1 vkFP) = - unsafeDupablePerformIO . withForeignPtr vkFP $ \vkp -> - unsafePackCStringLen (castPtr vkp, 64) - {-# NOINLINE rawSerialiseSignKeyDSIGN #-} - rawSerialiseSignKeyDSIGN (SignKeySchnorr256k1 skFP) = - unsafeDupablePerformIO . withForeignPtr skFP $ \skp -> - unsafePackCStringLen (castPtr skp, 32) - rawDeserialiseVerKeyDSIGN bs - | BS.length bs == 64 = - let (bsFP, bsOff, _) = toForeignPtr bs in - pure . - VerKeySchnorr256k1 . - castForeignPtr . - plusForeignPtr bsFP $ bsOff - | otherwise = Nothing - rawDeserialiseSignKeyDSIGN bs - | BS.length bs == 32 = - let (bsFP, bsOff, _) = toForeignPtr bs in - pure . - SignKeySchnorr256k1 . - castForeignPtr . - plusForeignPtr bsFP $ bsOff - | otherwise = Nothing - rawDeserialiseSigDSIGN bs - | BS.length bs == 64 = - let (bsFP, bsOff, _) = toForeignPtr bs in - pure . - SigSchnorr256k1 . - castForeignPtr . - plusForeignPtr bsFP $ bsOff - | otherwise = Nothing - -instance Eq (VerKeyDSIGN SchnorrSecp256k1DSIGN) where - {-# NOINLINE (==) #-} - VerKeySchnorr256k1 fp == VerKeySchnorr256k1 fp' = - unsafeDupablePerformIO . withForeignPtr fp $ \p -> - withForeignPtr fp' $ \p' -> do - res <- memcmp (castPtr p) (castPtr p') 64 - pure $ case res of - 0 -> True - _ -> False - -instance Eq (SignKeyDSIGN SchnorrSecp256k1DSIGN) where - {-# NOINLINE (==) #-} - SignKeySchnorr256k1 fp == SignKeySchnorr256k1 fp' = - unsafeDupablePerformIO . withForeignPtr fp $ \p -> - withForeignPtr fp' $ \p' -> do - res <- memcmp (castPtr p) (castPtr p') 32 - pure $ case res of - 0 -> True - _ -> False - -instance Eq (SigDSIGN SchnorrSecp256k1DSIGN) where - {-# NOINLINE (==) #-} - SigSchnorr256k1 fp == SigSchnorr256k1 fp' = - unsafeDupablePerformIO . withForeignPtr fp $ \p -> - withForeignPtr fp' $ \p' -> do - res <- memcmp (castPtr p) (castPtr p') 64 - pure $ case res of - 0 -> True - _ -> False - -instance Show (VerKeyDSIGN SchnorrSecp256k1DSIGN) where - {-# NOINLINE show #-} - show (VerKeySchnorr256k1 fp) = - ("VerKeySchnorr256k1 " <>) . - show . - unsafeDupablePerformIO . - withForeignPtr fp $ \p -> - unsafePackCStringLen (castPtr p, 64) - -instance Show (SignKeyDSIGN SchnorrSecp256k1DSIGN) where - {-# NOINLINE show #-} - show (SignKeySchnorr256k1 fp) = - ("SignKeySchnorr256k1 " <>) . - show . - unsafeDupablePerformIO . - withForeignPtr fp $ \p -> - unsafePackCStringLen (castPtr p, 32) - -instance Show (SigDSIGN SchnorrSecp256k1DSIGN) where - {-# NOINLINE show #-} - show (SigSchnorr256k1 fp) = - ("SigSchnorr256k1 " <>) . - show . - unsafeDupablePerformIO . - withForeignPtr fp $ \p -> - unsafePackCStringLen (castPtr p, 64) + psb <- withForeignPtr (plusForeignPtr bsFP bsOff) $ \bsp -> do + psbCreate $ \skp -> do + copyPtr skp bsp 32 + pure . pure . SignKeySchnorr256k1 $ psb + rawSerialiseSigDSIGN (SigSchnorr256k1 sigPSB) = psbToByteString sigPSB + rawSerialiseVerKeyDSIGN (VerKeySchnorr256k1 vkPSB) = psbToByteString vkPSB + rawSerialiseSignKeyDSIGN (SignKeySchnorr256k1 skPSB) = psbToByteString skPSB + rawDeserialiseVerKeyDSIGN bs = + VerKeySchnorr256k1 <$> psbFromByteStringCheck bs + rawDeserialiseSignKeyDSIGN bs = + SignKeySchnorr256k1 <$> psbFromByteStringCheck bs + rawDeserialiseSigDSIGN bs = + SigSchnorr256k1 <$> psbFromByteStringCheck bs instance ToCBOR (VerKeyDSIGN SchnorrSecp256k1DSIGN) where toCBOR = encodeVerKeyDSIGN From f6c2453755b9a94a5221b901f5d60645854a1324 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Mon, 28 Feb 2022 13:31:09 +1300 Subject: [PATCH 11/13] Rewrite Schnorr with useAsCStringLen --- .../Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs | 43 ++++++++----------- 1 file changed, 17 insertions(+), 26 deletions(-) diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs index f699b6957..30273742d 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs @@ -25,13 +25,12 @@ module Cardano.Crypto.DSIGN.SchnorrSecp256k1 ( SigDSIGN ) where +import Data.ByteString (useAsCStringLen) import GHC.Generics (Generic) import Control.DeepSeq (NFData) import Data.Primitive.Ptr (copyPtr) import Crypto.Random (getRandomBytes) import Cardano.Crypto.Seed (runMonadRandomWithSeed) -import Data.ByteString.Internal (toForeignPtr) -import Foreign.ForeignPtr (withForeignPtr, plusForeignPtr) import Control.Monad (when) import System.IO.Unsafe (unsafeDupablePerformIO, unsafePerformIO) import Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (toCBOR, encodedSizeExpr)) @@ -131,43 +130,35 @@ instance DSIGNAlgorithm SchnorrSecp256k1DSIGN where allocaBytes 96 $ \kpp -> do res <- secpKeyPairCreate ctxPtr kpp skp' when (res /= 1) (error "signDSIGN: Failed to create keypair") - let (msgFP, msgOff, msgLen) = toForeignPtr bs - sigPSB <- psbCreate $ \sigp -> - withForeignPtr (plusForeignPtr msgFP msgOff) $ \msgp -> do - res' <- secpSchnorrSigSignCustom ctxPtr - (castPtr sigp) - (castPtr msgp) - (fromIntegral msgLen) - kpp - nullPtr - when (res' /= 1) - (error "signDSIGN: Failed to sign message") + sigPSB <- psbCreate $ \sigp -> useAsCStringLen bs $ \(msgp, msgLen) -> do + res' <- secpSchnorrSigSignCustom ctxPtr + (castPtr sigp) + (castPtr msgp) + (fromIntegral msgLen) + kpp + nullPtr + when (res' /= 1) (error "signDSIGN: Failed to sign message") pure . SigSchnorr256k1 $ sigPSB {-# NOINLINE verifyDSIGN #-} verifyDSIGN () (VerKeySchnorr256k1 pubkeyPSB) msg (SigSchnorr256k1 sigPSB) = unsafeDupablePerformIO . psbUseAsCPtr pubkeyPSB $ \pkp -> psbUseAsCPtr sigPSB $ \sigp -> do let bs = getSignableRepresentation msg - let (msgFP, msgOff, msgLen) = toForeignPtr bs let sigp' :: Ptr CUChar = castPtr sigp - res <- withForeignPtr (plusForeignPtr msgFP msgOff) $ \msgp -> - pure $ - secpSchnorrSigVerify ctxPtr - sigp' - (castPtr msgp) - (fromIntegral msgLen) - (castPtr pkp) + res <- useAsCStringLen bs $ \(msgp, msgLen) -> do + pure $ secpSchnorrSigVerify ctxPtr + sigp' + (castPtr msgp) + (fromIntegral msgLen) + (castPtr pkp) pure $ if res == 0 then Left "Schnorr signature failed to verify." else pure () {-# NOINLINE genKeyDSIGN #-} genKeyDSIGN seed = runMonadRandomWithSeed seed $ do bs <- getRandomBytes 32 - unsafeDupablePerformIO $ do - let (bsFP, bsOff, _) = toForeignPtr bs - psb <- withForeignPtr (plusForeignPtr bsFP bsOff) $ \bsp -> do - psbCreate $ \skp -> do - copyPtr skp bsp 32 + unsafeDupablePerformIO . useAsCStringLen bs $ \(bsp, _) -> do + psb <- psbCreate $ \skp -> copyPtr skp (castPtr bsp) 32 pure . pure . SignKeySchnorr256k1 $ psb rawSerialiseSigDSIGN (SigSchnorr256k1 sigPSB) = psbToByteString sigPSB rawSerialiseVerKeyDSIGN (VerKeySchnorr256k1 vkPSB) = psbToByteString vkPSB From a7a77abdbc768cb17e1138126f4bc65e4e6e3056 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Tue, 1 Mar 2022 07:25:27 +1300 Subject: [PATCH 12/13] Remove magic number on copyPtr --- .../src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs index 30273742d..23416ecff 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs @@ -6,6 +6,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TypeApplications #-} -- According to the documentation for unsafePerformIO: -- -- > Make sure that the either you switch off let-floating @@ -25,6 +26,8 @@ module Cardano.Crypto.DSIGN.SchnorrSecp256k1 ( SigDSIGN ) where +import GHC.TypeNats (natVal) +import Data.Proxy (Proxy (Proxy)) import Data.ByteString (useAsCStringLen) import GHC.Generics (Generic) import Control.DeepSeq (NFData) @@ -158,7 +161,8 @@ instance DSIGNAlgorithm SchnorrSecp256k1DSIGN where genKeyDSIGN seed = runMonadRandomWithSeed seed $ do bs <- getRandomBytes 32 unsafeDupablePerformIO . useAsCStringLen bs $ \(bsp, _) -> do - psb <- psbCreate $ \skp -> copyPtr skp (castPtr bsp) 32 + psb <- psbCreate $ \skp -> copyPtr skp (castPtr bsp) + (fromIntegral . natVal $ Proxy @(SizeSignKeyDSIGN SchnorrSecp256k1DSIGN)) pure . pure . SignKeySchnorr256k1 $ psb rawSerialiseSigDSIGN (SigSchnorr256k1 sigPSB) = psbToByteString sigPSB rawSerialiseVerKeyDSIGN (VerKeySchnorr256k1 vkPSB) = psbToByteString vkPSB From 0557a3a10f6829b8ddb2201026753942979af23d Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Tue, 1 Mar 2022 07:32:44 +1300 Subject: [PATCH 13/13] Rename SECP import to ECDSA, clearer constructor names for Schnorr --- .../Cardano/Crypto/DSIGN/EcdsaSecp256k1.hs | 24 +++++++-------- .../Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs | 30 +++++++++---------- 2 files changed, 27 insertions(+), 27 deletions(-) diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/EcdsaSecp256k1.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/EcdsaSecp256k1.hs index 66a8dd8fd..cd5e7d223 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/EcdsaSecp256k1.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/EcdsaSecp256k1.hs @@ -23,7 +23,7 @@ import Data.Serialize (Serialize (get, put), runPut, runGet) import Data.Kind (Type) import GHC.Generics (Generic) import Control.DeepSeq (NFData) -import qualified Crypto.Secp256k1 as SECP +import qualified Crypto.Secp256k1 as ECDSA import NoThunks.Class (NoThunks) import Cardano.Crypto.DSIGN.Class ( DSIGNAlgorithm (VerKeyDSIGN, @@ -69,31 +69,31 @@ instance DSIGNAlgorithm EcdsaSecp256k1DSIGN where type SizeSigDSIGN EcdsaSecp256k1DSIGN = 64 type SizeSignKeyDSIGN EcdsaSecp256k1DSIGN = 32 type SizeVerKeyDSIGN EcdsaSecp256k1DSIGN = 64 - type Signable EcdsaSecp256k1DSIGN = ((~) SECP.Msg) + type Signable EcdsaSecp256k1DSIGN = ((~) ECDSA.Msg) newtype VerKeyDSIGN EcdsaSecp256k1DSIGN = - VerKeyEcdsaSecp256k1 SECP.PubKey + VerKeyEcdsaSecp256k1 ECDSA.PubKey deriving newtype (Eq, NFData) deriving stock (Show, Generic) newtype SignKeyDSIGN EcdsaSecp256k1DSIGN = - SignKeyEcdsaSecp256k1 SECP.SecKey + SignKeyEcdsaSecp256k1 ECDSA.SecKey deriving newtype (Eq, NFData) deriving stock (Show, Generic) newtype SigDSIGN EcdsaSecp256k1DSIGN = - SigEcdsaSecp256k1 SECP.Sig + SigEcdsaSecp256k1 ECDSA.Sig deriving newtype (Eq, NFData) deriving stock (Show, Generic) algorithmNameDSIGN _ = "ecdsa-secp256k1" deriveVerKeyDSIGN (SignKeyEcdsaSecp256k1 sk) = - VerKeyEcdsaSecp256k1 . SECP.derivePubKey $ sk + VerKeyEcdsaSecp256k1 . ECDSA.derivePubKey $ sk signDSIGN () msg (SignKeyEcdsaSecp256k1 k) = - SigEcdsaSecp256k1 . SECP.signMsg k $ msg + SigEcdsaSecp256k1 . ECDSA.signMsg k $ msg verifyDSIGN () (VerKeyEcdsaSecp256k1 pk) msg (SigEcdsaSecp256k1 sig) = - if SECP.verifySig pk sig msg + if ECDSA.verifySig pk sig msg then pure () else Left "ECDSA-SECP256k1 signature not verified" genKeyDSIGN seed = runMonadRandomWithSeed seed $ do bs <- getRandomBytes 32 - case SECP.secKey bs of + case ECDSA.secKey bs of Nothing -> error "Failed to construct a ECDSA-SECP256k1 secret key unexpectedly" Just sk -> pure . SignKeyEcdsaSecp256k1 $ sk rawSerialiseSigDSIGN (SigEcdsaSecp256k1 sig) = putting sig @@ -129,11 +129,11 @@ instance FromCBOR (SigDSIGN EcdsaSecp256k1DSIGN) where -- Required orphans -instance NoThunks SECP.PubKey +instance NoThunks ECDSA.PubKey -instance NoThunks SECP.SecKey +instance NoThunks ECDSA.SecKey -instance NoThunks SECP.Sig +instance NoThunks ECDSA.Sig -- Helpers diff --git a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs index 23416ecff..3cd9af9ab 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs @@ -98,23 +98,23 @@ instance DSIGNAlgorithm SchnorrSecp256k1DSIGN where type SizeVerKeyDSIGN SchnorrSecp256k1DSIGN = 64 type Signable SchnorrSecp256k1DSIGN = SignableRepresentation newtype VerKeyDSIGN SchnorrSecp256k1DSIGN = - VerKeySchnorr256k1 (PinnedSizedBytes (SizeVerKeyDSIGN SchnorrSecp256k1DSIGN)) + VerKeySchnorrSecp256k1 (PinnedSizedBytes (SizeVerKeyDSIGN SchnorrSecp256k1DSIGN)) deriving newtype (Eq, NFData) deriving stock (Show, Generic) deriving anyclass (NoThunks) newtype SignKeyDSIGN SchnorrSecp256k1DSIGN = - SignKeySchnorr256k1 (PinnedSizedBytes (SizeSignKeyDSIGN SchnorrSecp256k1DSIGN)) + SignKeySchnorrSecp256k1 (PinnedSizedBytes (SizeSignKeyDSIGN SchnorrSecp256k1DSIGN)) deriving newtype (Eq, NFData) deriving stock (Show, Generic) deriving anyclass (NoThunks) newtype SigDSIGN SchnorrSecp256k1DSIGN = - SigSchnorr256k1 (PinnedSizedBytes (SizeSigDSIGN SchnorrSecp256k1DSIGN)) + SigSchnorrSecp256k1 (PinnedSizedBytes (SizeSigDSIGN SchnorrSecp256k1DSIGN)) deriving newtype (Eq, NFData) deriving stock (Show, Generic) deriving anyclass (NoThunks) algorithmNameDSIGN _ = "schnorr-secp256k1" {-# NOINLINE deriveVerKeyDSIGN #-} - deriveVerKeyDSIGN (SignKeySchnorr256k1 psb) = + deriveVerKeyDSIGN (SignKeySchnorrSecp256k1 psb) = unsafeDupablePerformIO . psbUseAsCPtr psb $ \skp -> do let skp' :: Ptr CUChar = castPtr skp allocaBytes 96 $ \kpp -> do @@ -124,9 +124,9 @@ instance DSIGNAlgorithm SchnorrSecp256k1DSIGN where res' <- secpKeyPairXOnlyPub ctxPtr (castPtr xonlyp) nullPtr kpp when (res' /= 1) (error "deriveVerKeyDsIGN: could not extract xonly pubkey") - pure . VerKeySchnorr256k1 $ xonlyPSB + pure . VerKeySchnorrSecp256k1 $ xonlyPSB {-# NOINLINE signDSIGN #-} - signDSIGN () msg (SignKeySchnorr256k1 skpsb) = + signDSIGN () msg (SignKeySchnorrSecp256k1 skpsb) = unsafeDupablePerformIO . psbUseAsCPtr skpsb $ \skp -> do let bs = getSignableRepresentation msg let skp' :: Ptr CUChar = castPtr skp @@ -141,9 +141,9 @@ instance DSIGNAlgorithm SchnorrSecp256k1DSIGN where kpp nullPtr when (res' /= 1) (error "signDSIGN: Failed to sign message") - pure . SigSchnorr256k1 $ sigPSB + pure . SigSchnorrSecp256k1 $ sigPSB {-# NOINLINE verifyDSIGN #-} - verifyDSIGN () (VerKeySchnorr256k1 pubkeyPSB) msg (SigSchnorr256k1 sigPSB) = + verifyDSIGN () (VerKeySchnorrSecp256k1 pubkeyPSB) msg (SigSchnorrSecp256k1 sigPSB) = unsafeDupablePerformIO . psbUseAsCPtr pubkeyPSB $ \pkp -> psbUseAsCPtr sigPSB $ \sigp -> do let bs = getSignableRepresentation msg @@ -163,16 +163,16 @@ instance DSIGNAlgorithm SchnorrSecp256k1DSIGN where unsafeDupablePerformIO . useAsCStringLen bs $ \(bsp, _) -> do psb <- psbCreate $ \skp -> copyPtr skp (castPtr bsp) (fromIntegral . natVal $ Proxy @(SizeSignKeyDSIGN SchnorrSecp256k1DSIGN)) - pure . pure . SignKeySchnorr256k1 $ psb - rawSerialiseSigDSIGN (SigSchnorr256k1 sigPSB) = psbToByteString sigPSB - rawSerialiseVerKeyDSIGN (VerKeySchnorr256k1 vkPSB) = psbToByteString vkPSB - rawSerialiseSignKeyDSIGN (SignKeySchnorr256k1 skPSB) = psbToByteString skPSB + pure . pure . SignKeySchnorrSecp256k1 $ psb + rawSerialiseSigDSIGN (SigSchnorrSecp256k1 sigPSB) = psbToByteString sigPSB + rawSerialiseVerKeyDSIGN (VerKeySchnorrSecp256k1 vkPSB) = psbToByteString vkPSB + rawSerialiseSignKeyDSIGN (SignKeySchnorrSecp256k1 skPSB) = psbToByteString skPSB rawDeserialiseVerKeyDSIGN bs = - VerKeySchnorr256k1 <$> psbFromByteStringCheck bs + VerKeySchnorrSecp256k1 <$> psbFromByteStringCheck bs rawDeserialiseSignKeyDSIGN bs = - SignKeySchnorr256k1 <$> psbFromByteStringCheck bs + SignKeySchnorrSecp256k1 <$> psbFromByteStringCheck bs rawDeserialiseSigDSIGN bs = - SigSchnorr256k1 <$> psbFromByteStringCheck bs + SigSchnorrSecp256k1 <$> psbFromByteStringCheck bs instance ToCBOR (VerKeyDSIGN SchnorrSecp256k1DSIGN) where toCBOR = encodeVerKeyDSIGN