module Network.Haskoin.Crypto.ECDSA
( SecretT
, Signature(..)
, withSource
, getEntropy
, signMsg
, verifySig
, genPrvKey
, isCanonicalHalfOrder
, decodeDerSig
, decodeStrictSig
) where
import Numeric (showHex)
import Control.DeepSeq (NFData, rnf)
import Control.Monad (when, unless, guard)
import Control.Monad.Trans (lift)
import qualified Control.Monad.State as S
( StateT
, evalStateT
, get, put
)
import Data.Maybe (fromMaybe)
import Data.Binary (Binary, get, put)
import Data.Binary.Put (putByteString, putByteString)
import Data.Binary.Get (getWord8, lookAhead, getByteString)
import Data.ByteString (ByteString)
import System.Entropy (getEntropy)
import qualified Crypto.Secp256k1 as EC
import Network.Haskoin.Constants
import Network.Haskoin.Crypto.Hash
import Network.Haskoin.Crypto.Keys
type SecretState m = (WorkingState, Int -> m ByteString)
type SecretT m = S.StateT (SecretState m) m
withSource :: Monad m => (Int -> m ByteString) -> SecretT m a -> m a
withSource f m = do
seed <- f 32
nonce <- f 16
let ws = hmacDRBGNew seed nonce haskoinUserAgent
S.evalStateT m (ws,f)
nextSecret :: Monad m => SecretT m EC.SecKey
nextSecret = do
(ws, f) <- S.get
let (ws', randM) = hmacDRBGGen ws 32 haskoinUserAgent
case randM of
(Just rand) -> do
S.put (ws', f)
case EC.secKey rand of
Just key -> return key
Nothing -> nextSecret
Nothing -> do
seed <- lift $ f 32
let ws0 = hmacDRBGRsd ws' seed haskoinUserAgent
S.put (ws0, f)
nextSecret
genPrvKey :: Monad m => SecretT m PrvKey
genPrvKey = makePrvKey <$> nextSecret
newtype Signature = Signature { getSignature :: EC.Sig }
deriving (Read, Show, Eq)
instance NFData Signature where
rnf (Signature s) = s `seq` ()
hashToMsg :: Hash256 -> EC.Msg
hashToMsg =
fromMaybe e . EC.msg . getHash256
where
e = error "Could not convert 32-byte hash to secp256k1 message"
signMsg :: Hash256 -> PrvKey -> Signature
signMsg h d = Signature $ EC.signMsg (prvKeySecKey d) (hashToMsg h)
verifySig :: Hash256 -> Signature -> PubKey -> Bool
verifySig h s q =
EC.verifySig p g m
where
(g, _) = EC.normalizeSig $ getSignature s
m = hashToMsg h
p = pubKeyPoint q
instance Binary Signature where
get = do
l <- lookAhead $ do
t <- getWord8
unless (t == 0x30) $ fail $
"Bad DER identifier byte 0x" ++ showHex t ". Expecting 0x30"
l <- getWord8
when (l == 0x00) $ fail "Indeterminate form unsupported"
when (l >= 0x80) $ fail "Multi-octect length not supported"
return $ fromIntegral l
bs <- getByteString $ l + 2
case decodeDerSig bs of
Just s -> return s
Nothing -> fail "Invalid signature"
put (Signature s) = putByteString $ EC.exportSig s
isCanonicalHalfOrder :: Signature -> Bool
isCanonicalHalfOrder = not . snd . EC.normalizeSig . getSignature
decodeDerSig :: ByteString -> Maybe Signature
decodeDerSig bs = Signature <$> EC.laxImportSig bs
decodeStrictSig :: ByteString -> Maybe Signature
decodeStrictSig bs = do
g <- EC.importSig bs
let compact = EC.exportCompactSig g
guard $ EC.getCompactSigR compact /= 0
guard $ EC.getCompactSigS compact /= 0
return $ Signature g