Add support for recoverable signatures

src/Crypto/Secp256k1.hs

@@ -1,8 +1,8 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 -- |
 -- Module      : Crypto.Secp256k1
@@ -46,6 +46,15 @@ module Crypto.Secp256k1
     exportCompactSig,
     importCompactSig,
 
+    -- ** Recovery
+    RecSig,
+    CompactRecSig (..),
+    importCompactRecSig,
+    exportCompactRecSig,
+    convertRecSig,
+    signRecMsg,
+    recover,
+
     -- * Addition & Multiplication
     Tweak,
     tweak,
@@ -70,11 +79,16 @@ import Data.Hashable (Hashable (..))
 import Data.Maybe (fromJust, fromMaybe, isJust)
 import Data.Serialize
   ( Serialize (..),
+    decode,
+    encode,
     getByteString,
+    getWord8,
     putByteString,
+    putWord8,
   )
 import Data.String (IsString (..))
 import Data.String.Conversions (ConvertibleStrings, cs)
+import Data.Word (Word8)
 import Foreign
   ( alloca,
     allocaArray,
@@ -120,6 +134,17 @@ newtype Tweak = Tweak {getTweak :: ByteString}
 newtype CompactSig = CompactSig {getCompactSig :: ByteString}
   deriving (Eq, Generic, NFData)
 
+newtype RecSig = RecSig {getRecSig :: ByteString}
+  deriving (Eq, Generic, NFData)
+
+data CompactRecSig = CompactRecSig
+  { getCompactRecSigRS :: !ByteString,
+    getCompactRecSigV :: {-# UNPACK #-} !Word8
+  }
+  deriving (Eq, Generic)
+
+instance NFData CompactRecSig
+
 instance Serialize PubKey where
   put (PubKey bs) = putByteString bs
   get = PubKey <$> getByteString 64
@@ -144,6 +169,14 @@ instance Serialize CompactSig where
   put (CompactSig bs) = putByteString bs
   get = CompactSig <$> getByteString 64
 
+instance Serialize RecSig where
+  put (RecSig bs) = putByteString bs
+  get = RecSig <$> getByteString 65
+
+instance Serialize CompactRecSig where
+  put (CompactRecSig bs v) = putByteString bs <> putWord8 v
+  get = CompactRecSig <$> getByteString 64 <*> getWord8
+
 decodeHex :: (ConvertibleStrings a ByteString) => a -> Maybe ByteString
 decodeHex str =
   if isBase16 $ cs str
@@ -477,3 +510,103 @@ instance Arbitrary SecKey where
 
 instance Arbitrary PubKey where
   arbitrary = derivePubKey <$> arbitrary
+
+recSigFromString :: String -> Maybe RecSig
+recSigFromString str = do
+  bs <- decodeHex str
+  rs <- either (const Nothing) Just $ decode bs
+  importCompactRecSig rs
+
+instance Hashable RecSig where
+  i `hashWithSalt` s = i `hashWithSalt` encode (exportCompactRecSig s)
+
+instance Read RecSig where
+  readPrec = parens $ do
+    String str <- lexP
+    maybe pfail return $ recSigFromString str
+
+instance IsString RecSig where
+  fromString = fromMaybe e . recSigFromString
+    where
+      e = error "Could not decode signature from hex string"
+
+instance Show RecSig where
+  showsPrec _ = shows . extractBase16 . encodeBase16 . encode . exportCompactRecSig
+
+-- | Parse a compact ECDSA signature (64 bytes + recovery id).
+importCompactRecSig :: CompactRecSig -> Maybe RecSig
+importCompactRecSig (CompactRecSig sig_rs sig_v)
+  | sig_v `notElem` [0, 1, 2, 3] = Nothing
+  | otherwise = unsafePerformIO $
+      unsafeUseByteString sig_rs $ \(sig_rs_ptr, _) -> do
+        out_rec_sig_ptr <- mallocBytes 65
+        ret <-
+          ecdsaRecoverableSignatureParseCompact
+            ctx
+            out_rec_sig_ptr
+            sig_rs_ptr
+            (fromIntegral sig_v)
+        if isSuccess ret
+          then do
+            out_bs <- unsafePackByteString (out_rec_sig_ptr, 65)
+            return (Just (RecSig out_bs))
+          else do
+            free out_rec_sig_ptr
+            return Nothing
+
+-- | Serialize an ECDSA signature in compact format (64 bytes + recovery id).
+exportCompactRecSig :: RecSig -> CompactRecSig
+exportCompactRecSig (RecSig rec_sig_bs) = unsafePerformIO $
+  unsafeUseByteString rec_sig_bs $ \(rec_sig_ptr, _) ->
+    alloca $ \out_v_ptr -> do
+      out_sig_ptr <- mallocBytes 64
+      ret <-
+        ecdsaRecoverableSignatureSerializeCompact
+          ctx
+          out_sig_ptr
+          out_v_ptr
+          rec_sig_ptr
+      unless (isSuccess ret) $ do
+        free out_sig_ptr
+        error "Could not obtain compact signature"
+      out_bs <- unsafePackByteString (out_sig_ptr, 64)
+      out_v <- peek out_v_ptr
+      return $ CompactRecSig out_bs (fromIntegral out_v)
+
+-- | Convert a recoverable signature into a normal signature.
+convertRecSig :: RecSig -> Sig
+convertRecSig (RecSig rec_sig_bs) = unsafePerformIO $
+  unsafeUseByteString rec_sig_bs $ \(rec_sig_ptr, _) -> do
+    out_ptr <- mallocBytes 64
+    ret <- ecdsaRecoverableSignatureConvert ctx out_ptr rec_sig_ptr
+    unless (isSuccess ret) $
+      error "Could not convert a recoverable signature"
+    out_bs <- unsafePackByteString (out_ptr, 64)
+    return $ Sig out_bs
+
+-- | Create a recoverable ECDSA signature.
+signRecMsg :: SecKey -> Msg -> RecSig
+signRecMsg (SecKey sec_key) (Msg m) = unsafePerformIO $
+  unsafeUseByteString sec_key $ \(sec_key_ptr, _) ->
+    unsafeUseByteString m $ \(msg_ptr, _) -> do
+      rec_sig_ptr <- mallocBytes 65
+      ret <- ecdsaSignRecoverable ctx rec_sig_ptr msg_ptr sec_key_ptr nullFunPtr nullPtr
+      unless (isSuccess ret) $ do
+        free rec_sig_ptr
+        error "could not sign message"
+      RecSig <$> unsafePackByteString (rec_sig_ptr, 65)
+
+-- | Recover an ECDSA public key from a signature.
+recover :: RecSig -> Msg -> Maybe PubKey
+recover (RecSig rec_sig) (Msg m) = unsafePerformIO $
+  unsafeUseByteString rec_sig $ \(rec_sig_ptr, _) ->
+    unsafeUseByteString m $ \(msg_ptr, _) -> do
+      pub_key_ptr <- mallocBytes 64
+      ret <- ecdsaRecover ctx pub_key_ptr rec_sig_ptr msg_ptr
+      if isSuccess ret
+        then do
+          pub_key_bs <- unsafePackByteString (pub_key_ptr, 64)
+          return (Just (PubKey pub_key_bs))
+        else do
+          free pub_key_ptr
+          return Nothing

src/Crypto/Secp256k1/Internal.hs

@@ -13,6 +13,7 @@ module Crypto.Secp256k1.Internal where
 import           Data.ByteString        (ByteString)
 import qualified Data.ByteString        as BS
 import qualified Data.ByteString.Unsafe as BU
+import           Data.Void              (Void)
 import           Foreign                (FunPtr, Ptr, castPtr)
 import           Foreign.C              (CInt (..), CSize (..), CString, CUChar,
                                          CUInt (..))
@@ -23,6 +24,7 @@ data PubKey64
 data Msg32
 data Sig64
 data Compact64
+data RecSig65
 data Seed32
 data SecKey32
 data Tweak32
@@ -268,3 +270,49 @@ foreign import ccall safe
     -> Ptr (Ptr PubKey64) -- ^ pointer to array of public keys
     -> CInt               -- ^ number of public keys
     -> IO Ret
+
+foreign import ccall safe
+    "secp256k1_recovery.h secp256k1_ecdsa_recoverable_signature_parse_compact"
+    ecdsaRecoverableSignatureParseCompact
+    :: Ctx
+    -> Ptr RecSig65
+    -> Ptr Compact64
+    -> CInt
+    -> IO Ret
+
+foreign import ccall safe
+    "secp256k1_recovery.h secp256k1_ecdsa_recoverable_signature_convert"
+    ecdsaRecoverableSignatureConvert
+    :: Ctx
+    -> Ptr Sig64
+    -> Ptr RecSig65
+    -> IO Ret
+
+foreign import ccall safe
+    "secp256k1_recovery.h secp256k1_ecdsa_recoverable_signature_serialize_compact"
+    ecdsaRecoverableSignatureSerializeCompact
+    :: Ctx
+    -> Ptr Compact64
+    -> Ptr CInt
+    -> Ptr RecSig65
+    -> IO Ret
+
+foreign import ccall safe
+    "secp256k1_recovery.h secp256k1_ecdsa_sign_recoverable"
+    ecdsaSignRecoverable
+    :: Ctx
+    -> Ptr RecSig65
+    -> Ptr Msg32
+    -> Ptr SecKey32
+    -> FunPtr (NonceFun a)
+    -> Ptr a -- ^ nonce data
+    -> IO Ret
+
+foreign import ccall safe
+    "secp256k1_recovery.h secp256k1_ecdsa_recover"
+    ecdsaRecover
+    :: Ctx
+    -> Ptr PubKey64
+    -> Ptr RecSig65
+    -> Ptr Msg32
+    -> IO Ret

test/Crypto/Secp256k1Spec.hs

@@ -9,6 +9,7 @@ import Data.ByteString.Base16 (decodeBase16, encodeBase16)
 import qualified Data.ByteString.Char8 as B8
 import Data.Either (fromRight)
 import Data.Maybe (fromMaybe, isNothing)
+import Data.Serialize (decode, encode)
 import Data.String (fromString)
 import Data.String.Conversions (cs)
 import Test.HUnit (Assertion, assertEqual)
@@ -67,6 +68,20 @@ spec = do
     it "combine public keys" $ property combinePubKeyTest
     it "can't combine 0 public keys" $ property combinePubKeyEmptyListTest
     it "negates tweak" $ property negateTweakTest
+  describe "recovery" $ do
+    it "recovers public keys" $
+        property recoverTest
+    it "recovers key from signed message" $
+        property signRecMsgTest
+    it "does not recover bad public keys" $
+        property badRecoverTest
+    it "detects bad recoverable signature" $
+        property badRecSignatureTest
+    it "serializes compact recoverable signature" $
+        property serializeCompactRecSigTest
+    it "shows and reads recoverable signature" $
+        property (showReadRecSig :: (SecKey, Msg) -> Bool)
+    it "reads recoverable signature from string" $ property $ isStringRecSig
 
 hexToBytes :: String -> BS.ByteString
 hexToBytes = decodeBase16 . assertBase16 . B8.pack
@@ -82,6 +97,12 @@ isStringSig (k, m) = g == fromString (cs hex)
     g = signMsg k m
     hex = extractBase16 . encodeBase16 $ exportSig g
 
+isStringRecSig :: (SecKey, Msg) -> Bool
+isStringRecSig (k, m) = g == fromString (cs hex)
+  where
+    g = signRecMsg k m
+    hex = extractBase16 . encodeBase16 . encode $ exportCompactRecSig g
+
 isStringMsg :: Msg -> Bool
 isStringMsg m = m == fromString (cs m')
   where
@@ -109,6 +130,11 @@ showReadSig (k, m) = showRead sig
   where
     sig = signMsg k m
 
+showReadRecSig :: (SecKey, Msg) -> Bool
+showReadRecSig (k, m) = showRead recSig
+  where
+    recSig = signRecMsg k m
+
 showRead :: (Show a, Read a, Eq a) => a -> Bool
 showRead x = read (show x) == x
 
@@ -123,11 +149,36 @@ signMsgParTest xs = P.runPar $ do
   ys <- mapM (P.spawnP . signMsgTest) xs
   and <$> mapM P.get ys
 
+signRecMsgTest :: (Msg, SecKey) -> Bool
+signRecMsgTest (fm, fk) = verifySig fp fg fm
+  where
+    fp = derivePubKey fk
+    fg = convertRecSig $ signRecMsg fk fm
+
+recoverTest :: (Msg, SecKey) -> Bool
+recoverTest (fm, fk) = recover fg fm == Just fp
+  where
+    fp = derivePubKey fk
+    fg = signRecMsg fk fm
+
+badRecoverTest :: (Msg, SecKey, Msg) -> Property
+badRecoverTest (fm, fk, fm') =
+  fm' /= fm ==> fp' /= Nothing ==> fp' /= Just fp
+  where
+    fg  = signRecMsg fk fm
+    fp  = derivePubKey fk
+    fp' = recover fg fm'
+
 badSignatureTest :: (Msg, SecKey, PubKey) -> Bool
 badSignatureTest (fm, fk, fp) = not $ verifySig fp fg fm
   where
     fg = signMsg fk fm
 
+badRecSignatureTest :: (Msg, SecKey, PubKey) -> Bool
+badRecSignatureTest (fm, fk, fp) = not $ verifySig fp fg fm
+  where
+    fg = convertRecSig $ signRecMsg fk fm
+
 normalizeSigTest :: (Msg, SecKey) -> Bool
 normalizeSigTest (fm, fk) = isNothing sig
   where
@@ -166,6 +217,14 @@ serializeCompactSigTest (fm, fk) =
   where
     fg = signMsg fk fm
 
+serializeCompactRecSigTest :: (Msg, SecKey) -> Bool
+serializeCompactRecSigTest (fm, fk) =
+  case importCompactRecSig $ exportCompactRecSig fg of
+    Just fg' -> fg == fg'
+    Nothing  -> False
+  where
+    fg = signRecMsg fk fm
+
 serializeSecKeyTest :: SecKey -> Bool
 serializeSecKeyTest fk =
   case secKey $ getSecKey fk of