{-# 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 =
    forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Msg
msg forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  where
    e :: a
e = forall a. HasCallStack => [Char] -> a
error [Char]
"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 SecKey
k = SecKey -> Msg -> Sig
signMsg SecKey
k 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 Hash256
h Sig
s PubKey
p = PubKey -> Sig -> Msg -> Bool
verifySig PubKey
p Sig
norm (Hash256 -> Msg
hashToMsg Hash256
h)
  where
    norm :: Sig
norm = 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 :: forall (m :: * -> *). MonadGet m => m Sig
getSig = do
    Int
l <-
        forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$ do
            Word8
t <- forall (m :: * -> *). MonadGet m => m Word8
getWord8
            -- 0x30 is DER sequence type
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
t forall a. Eq a => a -> a -> Bool
== Word8
0x30) forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
                    [Char]
"Bad DER identifier byte 0x" forall a. [a] -> [a] -> [a]
++ forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
t [Char]
". Expecting 0x30"
            Word8
l <- forall (m :: * -> *). MonadGet m => m Word8
getWord8
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
l forall a. Eq a => a -> a -> Bool
== Word8
0x00) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Indeterminate form unsupported"
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
l forall a. Ord a => a -> a -> Bool
>= Word8
0x80) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Multi-octect length not supported"
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
l
    ByteString
bs <- forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString forall a b. (a -> b) -> a -> b
$ Int
l forall a. Num a => a -> a -> a
+ Int
2
    case ByteString -> Maybe Sig
decodeStrictSig ByteString
bs of
        Just Sig
s -> forall (m :: * -> *) a. Monad m => a -> m a
return Sig
s
        Maybe Sig
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid signature"

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

-- | Is canonical half order.
isCanonicalHalfOrder :: Sig -> Bool
isCanonicalHalfOrder :: Sig -> Bool
isCanonicalHalfOrder = forall a. Maybe a -> Bool
isNothing 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 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 Int
32 Word8
0
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 (CompactSig -> ByteString
getCompactSig CompactSig
compact) forall a. Eq a => a -> a -> Bool
/= ByteString
zero
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 (Int -> ByteString -> ByteString
BS.drop Int
32 (CompactSig -> ByteString
getCompactSig CompactSig
compact)) forall a. Eq a => a -> a -> Bool
/= ByteString
zero
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Sig -> Bool
isCanonicalHalfOrder Sig
g
    forall (m :: * -> *) a. Monad m => a -> m a
return Sig
g