module Bitcoin.Crypto.EC.DSA where
import Control.Monad
import Prelude hiding ( sqrt )
import Data.Char
import Data.Bits
import Data.Word
import Data.Maybe
import qualified Data.ByteString as B
import System.Random
import Bitcoin.Misc.HexString
import Bitcoin.Misc.BigInt
import Bitcoin.Misc.OctetStream
import Bitcoin.Protocol.Hash
import Bitcoin.Crypto.FiniteField.Fast.Fp hiding ( secp256k1_p )
import Bitcoin.Crypto.FiniteField.Naive.Fn hiding ( secp256k1_n )
import Bitcoin.Crypto.Hash.HMAC ( HMAC(..) , HMACKey , hmacSha256 , hmacKeyFromString64 )
import Bitcoin.Crypto.EC.Curve
import Bitcoin.Crypto.EC.Projective
import Bitcoin.Crypto.EC.Key
data Signature = Signature { _signatureR :: !Integer , _signatureS :: !Integer } deriving (Eq,Show)
newtype SignBits = SignBits Word8 deriving (Eq,Show)
hashInteger :: Hash256 -> Integer
hashInteger = toIntegerBE
signMessageHashIO :: PrivKey -> Hash256 -> IO (SignBits,Signature)
signMessageHashIO priv hash = getStdRandom (\gen -> signMessageHash priv hash gen)
signMessageHash :: RandomGen gen => PrivKey -> Hash256 -> gen -> ((SignBits,Signature),gen)
signMessageHash (PrivKey !da) !hash oldgen = go oldgen where
z = hashInteger hash
go gen = if (ep /= ECInfinity && r/=0 && s/=0) then ((SignBits w8, signature),gen') else go gen' where
signature = Signature (fromFn r) (fromFn s)
(!k,gen') = hashedRandom gen
epp = mulECP secp256k1_G_proj k
ep = fromECProj epp
(!x,!y) = case ep of
ECPoint x y -> (x,y)
ECInfinity -> error "signMessageHash: shouldn't happen"
r = fromInteger (fromFp x) :: Fn
s = (fromInteger z + r * fromInteger da) / (fromInteger k)
odd_y = if even (fromFp y) then 0 else 1
add_n = if fromFn r == fromFp x then 0 else 2
w8 = odd_y + add_n
hashedRandom gen = if k>1 && k<secp256k1_n then (k,gen'') else hashedRandom gen'' where
(k0,gen' ) = randomR (1,secp256k1_n) gen
(k1,gen'') = randomR (1,secp256k1_n) gen'
k = toIntegerBE
$ doHash256
$ (fromIntegerLE k0 ++ fromIntegerLE k1 ++ toWord8List hash ++ fromIntegerLE da ++ [0x12,0x34,0x56,0x78])
signMessageHashRFC6979 :: PrivKey -> Hash256 -> (SignBits,Signature)
signMessageHashRFC6979 (PrivKey da) hash = result where
hmac_k :: OctetStream a => a -> [Word8] -> [Word8]
hmac_k key = toWord8List . unHMAC . hmacSha256 (hmacKeyFromString64 key)
z = mod (hashInteger hash) secp256k1_n
x1 = bigEndianInteger32 da :: [Word8]
h1 = bigEndianInteger32 z :: [Word8]
v0 = replicate 32 0x01 :: [Word8]
k0 = replicate 32 0x00 :: [Word8]
k1 = hmac_k k0 $ v0 ++ [0x00] ++ x1 ++ h1
v1 = hmac_k k1 $ v0
k2 = hmac_k k1 $ v1 ++ [0x01] ++ x1 ++ h1
v2 = hmac_k k2 $ v1
result = step_h k2 v2
halfn = div secp256k1_n 2
step_h k v0 =
if dsa_k > 0 && dsa_k < secp256k1_n && ep /= ECInfinity && r/=0 && s/=0
then (signbits,signature)
else step_h k' v'
where
v = hmac_k k v0
t = v
dsa_k = toIntegerBE t
k' = hmac_k k $ v ++ [0x00]
v' = hmac_k k' $ v
epp = mulECP secp256k1_G_proj dsa_k
ep = fromECProj epp
(!x,!y) = case ep of
ECPoint x y -> (x,y)
ECInfinity -> error "signMessageHashRFC6979: shouldn't happen"
r = fromInteger (fromFp x) :: Fn
s0 = (fromInteger z + r * fromInteger da) / (fromInteger dsa_k) :: Fn
s = if (fromFn s0) > halfn then Fn (secp256k1_n fromFn s0) else s0
odd_y = if even (fromFp y) then 0 else 1
add_n = if fromFn r == fromFp x then 0 else 2
w8 = odd_y + add_n
signbits = SignBits w8
signature = Signature (fromFn r) (fromFn s)
verifySignatureWithHash :: PubKey -> Signature -> Hash256 -> Bool
verifySignatureWithHash pubkey0 signature hash = isJust mbpubkey && isValidPubKey pubkey && check where
mbpubkey = uncompressPubKey pubkey0
z = (fromInteger $ hashInteger hash) :: Fn
check = (r0>0 && r0 < secp256k1_n) && (s0>0 && s0 < secp256k1_n) && valid
Signature r0 s0 = signature
pubkey@(FullPubKey qx qy) = fromJust mbpubkey
w = recip (fromInteger s0 :: Fn)
r = fromInteger r0 :: Fn
u1 = fromFn (z * w)
u2 = fromFn (r * w)
qp = ECPoint (fromInteger qx :: Fp) (fromInteger qy :: Fp)
qpp = toECProj qp
ep = (mulECP secp256k1_G_proj u1) `addECP` (mulECP qpp u2)
valid = case fromECProj ep of
ECPoint x1 y1 -> fromFp x1 == r0
_ -> False
recoverPubKeyFromHash :: (PubKeyFormat,SignBits,Signature) -> Hash256 -> Maybe PubKey
recoverPubKeyFromHash (fmt, SignBits parities, Signature r s) hash = if isJust mbxy then Just cpubkey else Nothing where
z = hashInteger hash
cpubkey = formatPubKey fmt pubkey
pubkey = FullPubKey (fromFp qx) (fromFp qy)
x = if not add_n then r else modp (r + secp256k1_n)
mbxy = uncompressPubKey $ ComprPubKey (if odd_y then 3 else 2) x
Just (FullPubKey _ y) = mbxy
rr = ECPoint (toFp x) (toFp y)
rr_proj = toECProj rr
inv_r = fromFn (recip $ Fn $ modn r)
qqp = mulECP (sR_proj `subECP` zG_proj) inv_r
(!qx,!qy) = case fromECProj qqp of
ECPoint qx qy -> (qx,qy)
ECInfinity -> error "recoverPubKeyFromHash: shouldn't happen (???)"
sR_proj = mulECP rr_proj s
zG_proj = mulECP secp256k1_G_proj z
odd_y = (parities .&. 1) > 0
add_n = (parities .&. 2) > 0
ectest1 = do
let msg = B.pack $ map char_to_word8 $ "almafa kortefa"
let priv = PrivKey 420324792348973434283974283942354354
pub = computeFullPubKey priv
gen <- getStdGen
let ((signbits,signat),gen') = signMessageHash priv (doHash256 msg) gen
setStdGen gen'
print signat
let b = verifySignatureWithHash pub signat (doHash256 msg)
print b
when (not b) $ do
error $ "ECDSA signature check test failed for " ++ show (signat,gen)