{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Haskoin.Crypto.Signature
Copyright   : No rights reserved
License     : MIT
Maintainer  : jprupp@protonmail.ch
Stability   : experimental
Portability : POSIX

ECDSA signatures using secp256k1 curve. Uses functions from upstream secp256k1
library.
-}
module Haskoin.Crypto.Signature
    ( -- * Signatures
      putSig
    , getSig
    , signHash
    , verifyHashSig
    , isCanonicalHalfOrder
    , decodeStrictSig
    , exportSig
    ) where

import           Control.Monad       (guard, unless, when)
import           Crypto.Secp256k1
import           Data.Binary         (Binary (..))
import           Data.ByteString     (ByteString)
import qualified Data.ByteString     as BS
import           Data.Bytes.Get
import           Data.Bytes.Put
import           Data.Bytes.Serial
import           Data.Maybe          (fromMaybe, isNothing)
import           Data.Serialize      (Serialize (..))
import           Haskoin.Crypto.Hash
import           Numeric             (showHex)

-- | Convert 256-bit hash into a 'Msg' for signing or verification.
hashToMsg :: Hash256 -> Msg
hashToMsg :: Hash256 -> Msg
hashToMsg =
    Msg -> Maybe Msg -> Msg
forall a. a -> Maybe a -> a
fromMaybe Msg
forall a. a
e (Maybe Msg -> Msg) -> (Hash256 -> Maybe Msg) -> Hash256 -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Msg
msg (ByteString -> Maybe Msg)
-> (Hash256 -> ByteString) -> Hash256 -> Maybe Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> (Hash256 -> Put) -> Hash256 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  where
    e :: a
e = [Char] -> a
forall a. HasCallStack => [Char] -> a
error "Could not convert 32-byte hash to secp256k1 message"

-- | Sign a 256-bit hash using secp256k1 elliptic curve.
signHash :: SecKey -> Hash256 -> Sig
signHash :: SecKey -> Hash256 -> Sig
signHash k :: SecKey
k = SecKey -> Msg -> Sig
signMsg SecKey
k (Msg -> Sig) -> (Hash256 -> Msg) -> Hash256 -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash256 -> Msg
hashToMsg

-- | Verify an ECDSA signature for a 256-bit hash.
verifyHashSig :: Hash256 -> Sig -> PubKey -> Bool
verifyHashSig :: Hash256 -> Sig -> PubKey -> Bool
verifyHashSig h :: Hash256
h s :: Sig
s p :: PubKey
p = PubKey -> Sig -> Msg -> Bool
verifySig PubKey
p Sig
norm (Hash256 -> Msg
hashToMsg Hash256
h)
  where
    norm :: Sig
norm = Sig -> Maybe Sig -> Sig
forall a. a -> Maybe a -> a
fromMaybe Sig
s (Sig -> Maybe Sig
normalizeSig Sig
s)

-- | Deserialize an ECDSA signature as commonly encoded in Bitcoin.
getSig :: MonadGet m => m Sig
getSig :: m Sig
getSig = do
    Int
l <-
        m Int -> m Int
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead (m Int -> m Int) -> m Int -> m Int
forall a b. (a -> b) -> a -> b
$ do
            Word8
t <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
            -- 0x30 is DER sequence type
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x30) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                [Char] -> m ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$
                "Bad DER identifier byte 0x" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char] -> [Char]
forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex Word8
t ". Expecting 0x30"
            Word8
l <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
l Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x00) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail "Indeterminate form unsupported"
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
l Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 0x80) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail "Multi-octect length not supported"
            Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
l
    ByteString
bs <- Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString (Int -> m ByteString) -> Int -> m ByteString
forall a b. (a -> b) -> a -> b
$ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
    case ByteString -> Maybe Sig
decodeStrictSig ByteString
bs of
        Just s :: Sig
s  -> Sig -> m Sig
forall (m :: * -> *) a. Monad m => a -> m a
return Sig
s
        Nothing -> [Char] -> m Sig
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail "Invalid signature"

-- | Serialize an ECDSA signature for Bitcoin use.
putSig :: MonadPut m => Sig -> m ()
putSig :: Sig -> m ()
putSig s :: Sig
s = ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ Sig -> ByteString
exportSig Sig
s

-- | Is canonical half order.
isCanonicalHalfOrder :: Sig -> Bool
isCanonicalHalfOrder :: Sig -> Bool
isCanonicalHalfOrder = Maybe Sig -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Sig -> Bool) -> (Sig -> Maybe Sig) -> Sig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Maybe Sig
normalizeSig

-- | Decode signature strictly.
decodeStrictSig :: ByteString -> Maybe Sig
decodeStrictSig :: ByteString -> Maybe Sig
decodeStrictSig bs :: ByteString
bs = do
    Sig
g <- ByteString -> Maybe Sig
importSig ByteString
bs
    -- <http://www.secg.org/sec1-v2.pdf Section 4.1.4>
    -- 4.1.4.1 (r and s can not be zero)
    let compact :: CompactSig
compact = Sig -> CompactSig
exportCompactSig Sig
g
    let zero :: ByteString
zero = Int -> Word8 -> ByteString
BS.replicate 32 0
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take 32 (CompactSig -> ByteString
getCompactSig CompactSig
compact) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
zero
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take 32 (Int -> ByteString -> ByteString
BS.drop 32 (CompactSig -> ByteString
getCompactSig CompactSig
compact)) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
zero
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Sig -> Bool
isCanonicalHalfOrder Sig
g
    Sig -> Maybe Sig
forall (m :: * -> *) a. Monad m => a -> m a
return Sig
g