Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Schnorr signature support #258

Merged
merged 17 commits into from
Mar 2, 2022
Merged

Schnorr signature support #258

Changes from 1 commit
Commits
Show all changes
17 commits
Select commit Hold shift + click to select a range
a27a66c
Initial bindings
kozross Feb 14, 2022
87b4065
Try updating haskell.nix
kozross Feb 16, 2022
d085afd
Add nixpkgs pin, move to recent revision
michaelpj Feb 18, 2022
7a8c98b
Bump haskell.nix
michaelpj Feb 18, 2022
e227b99
Fix nixpkgs
michaelpj Feb 18, 2022
fcefd4f
Merge branch 'master' into mpj/bump-nixpkgs
michaelpj Feb 18, 2022
465f757
Merge branch 'mpj/bump-nixpkgs' of https://github.com/input-output-hk…
kozross Feb 20, 2022
68acbf7
Finish FFI bits
kozross Feb 20, 2022
332b95a
Rename the prior SECP work to be more accurate
kozross Feb 20, 2022
72f4266
Implement DSIGN interface for Schnorr signatures
kozross Feb 21, 2022
2bfa4d8
Add to test suite, ensure everything passes
kozross Feb 21, 2022
3caf9f8
Merge branch 'master' into koz/schnorr
kozross Feb 21, 2022
7436983
Rewrite Schnorr implementation with PinnedByteArray
kozross Feb 28, 2022
f6c2453
Rewrite Schnorr with useAsCStringLen
kozross Feb 28, 2022
a7a77ab
Remove magic number on copyPtr
kozross Feb 28, 2022
0557a3a
Rename SECP import to ECDSA, clearer constructor names for Schnorr
kozross Feb 28, 2022
ec9e615
Merge branch 'master' into koz/schnorr
kozross Mar 1, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
227 changes: 72 additions & 155 deletions cardano-crypto-class/src/Cardano/Crypto/DSIGN/SchnorrSecp256k1.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -22,38 +25,29 @@ 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))
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,
Expand Down Expand Up @@ -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

Expand All @@ -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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I note that this package has some utilities for slightly safer allocation, in here. I think you can use this in your foreign declarations (like here) to get some more safety and fewer magic numbers.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I saw that, but I actually don't think it helps all that much. I prefer keeping close to C, magic numbers and all, and avoiding the cost of 'calling down' type-level numbers to the value level.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Nonetheless, if it's going to be in this repository, I think it should follow the practices of this repository 🤷

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I respectfully disagree. You're injecting quite expensive code into (arguably) a hot code path for no real benefit, since nobody outside of the maintainers of this repo will see it. If magic numbers are a concern, I am happy to replace those with named constants.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You're injecting quite expensive code into (arguably) a hot code path for no real benefit

I think both of these are wrong:

  • The code is not expensive. GHC happily reifies the statically known information at compile time: I looked at the Core for the Ed25519 module and it has numeric literals as the size arguments.
  • This is not a hot path: we are calling expensive primitives, we shouldn't need to worry too much about the FFI overhead.

In any case, please remove the magic numbers. You already had to define named constants in the class: use them. I also don't think there's a good reason not to use the library helpers here, and it makes things more consistent.

res <- secpKeyPairCreate ctxPtr kpp skp'
when (res /= 1) (error "deriveVerKeyDSIGN: Failed to create keypair")
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The error handling around here seems a bit strange, but I note that some of the other modules at least throw IO exceptions: https://github.com/input-output-hk/cardano-base/blob/39f9cf0eaf15a6888a47ac9d8de0b37dd1131d0b/cardano-crypto-class/src/Cardano/Crypto/DSIGN/Ed25519.hs#L53

Perhaps that function could be moved to Cardano.Crypto.Util and used here too.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not sure whether error or an IO exception is more appropriate here. We're using unsafe*PerformIO everywhere anyway, so I don't think it makes that much difference.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

error throws an IOException anyway, doesn't it?

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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think you could replace many (all?) the uses of toForeignPointer with useAsCString(Len), which doesn't require the bytestring Internal module.

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 ()
Expand All @@ -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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

why did this change? Please replace the magic numbers with constants.

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
Expand Down