{-# LANGUAGE OverloadedStrings #-}
module Haskoin.Crypto.Signature
(
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)
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"
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
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)
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
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"
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
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
decodeStrictSig :: ByteString -> Maybe Sig
decodeStrictSig :: ByteString -> Maybe Sig
decodeStrictSig bs :: ByteString
bs = do
Sig
g <- ByteString -> Maybe Sig
importSig ByteString
bs
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