{-# 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.ByteString     (ByteString)
import qualified Data.ByteString     as BS
import           Data.Maybe          (fromMaybe, isNothing)
import           Data.Serialize      as S
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
. Hash256 -> ByteString
forall a. Serialize a => a -> ByteString
encode
  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 :: Get Sig
getSig :: Get Sig
getSig = do
    Int
l <-
        Get Int -> Get Int
forall a. Get a -> Get a
lookAhead (Get Int -> Get Int) -> Get Int -> Get Int
forall a b. (a -> b) -> a -> b
$ do
            Word8
t <- Get Word8
getWord8
            -- 0x30 is DER sequence type
            Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x30) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
                [Char] -> Get ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get ()) -> [Char] -> Get ()
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 <- Get Word8
getWord8
            Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
l Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x00) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Get ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail "Indeterminate form unsupported"
            Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
l Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 0x80) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Get ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail "Multi-octect length not supported"
            Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Get Int) -> Int -> Get 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 -> Get ByteString
getByteString (Int -> Get ByteString) -> Int -> Get 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 -> Get Sig
forall (m :: * -> *) a. Monad m => a -> m a
return Sig
s
        Nothing -> [Char] -> Get Sig
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail "Invalid signature"

-- | Serialize an ECDSA signature for Bitcoin use.
putSig :: Putter Sig
putSig :: Putter Sig
putSig s :: Sig
s = Putter ByteString
putByteString Putter ByteString -> Putter ByteString
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