diff options
| -rw-r--r-- | programmingbitcoin.cabal | 47 | ||||
| -rw-r--r-- | src/Ecc.hs (renamed from ecc.hs) | 86 |
2 files changed, 126 insertions, 7 deletions
diff --git a/programmingbitcoin.cabal b/programmingbitcoin.cabal new file mode 100644 index 0000000..11cda1a --- /dev/null +++ b/programmingbitcoin.cabal @@ -0,0 +1,47 @@ +cabal-version: 2.4 +name: programmingbitcoin +version: 0.1.0.0 + +-- A short (one-line) description of the package. +-- synopsis: + +-- A longer description of the package. +-- description: + +-- A URL where users can report bugs. +-- bug-reports: + +-- The license under which the package is released. +-- license: +author: Óscar Nájera +maintainer: hi@oscarnajera.com + +-- A copyright notice. +-- copyright: +-- category: +extra-source-files: + CHANGELOG.md + readme.org + +library + hs-source-dirs: src + exposed-modules: Ecc + build-depends: base ^>=4.14.1.0 + , bytestring >= 0.10.12.0 + , cryptohash-sha256 + default-language: Haskell2010 + +executable programmingbitcoin + main-is: Main.hs + + -- Modules included in this executable, other than Main. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + build-depends: base ^>=4.14.1.0 + , binary >= 0.8.8.0 + , bytestring >= 0.10.12.0 + , cryptohash-sha256 + hs-source-dirs: app + default-language: Haskell2010 @@ -1,13 +1,18 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} +module Ecc where + +import qualified Crypto.Hash.SHA256 as SHA256 import Data.Bits +import qualified Data.ByteString as BS import Data.Proxy import GHC.TypeLits -import Text.Printf (PrintfArg, printf) +import Text.Printf (PrintfArg, printf) -- FiniteFields --https://stackoverflow.com/questions/39823408/prime-finite-field-z-pz-in-haskell-with-operator-overloading @@ -184,19 +189,86 @@ s1 = signa1 = scalarProduct (asInt $ z1 / s1) gcons <> scalarProduct (asInt $ r1 / s1) pub -z2 = 0x7c076ff316692a3d7eb3c3bb0f8b1488cf72e1afcd929e29307032997a838a3d::NField -r2 = 0xeff69ef2b1bd93a66ed5219add4fb51e11a840f404876325a1e8ffe0529a2c::NField +z2 = + 0x7c076ff316692a3d7eb3c3bb0f8b1488cf72e1afcd929e29307032997a838a3d :: NField +r2 = 0xeff69ef2b1bd93a66ed5219add4fb51e11a840f404876325a1e8ffe0529a2c :: NField s2 = 0xc7207fee197d27c618aea621406f6bf5ef6fca38681d82b2f06fddbdce6feab6 :: NField data Signature = Signature - { r :: NField + { r :: S256Field , s :: NField - } + } deriving (Show) verifySignanture :: NField -> Signature -> S256Point -> Bool -verifySignanture z (Signature r s) pub = asInt (x target) == asInt r +verifySignanture z (Signature r s) pub = x target == r where target = - scalarProduct (asInt $ z / s) gcons <> scalarProduct (asInt $ r / s) pub + scalarProduct (asInt $ z / s) gcons + <> scalarProduct (asInt $ (fromIntegral (asInt r)) / s) pub + + +fromBytes :: BS.ByteString -> Integer +fromBytes = BS.foldl' f 0 where f a b = a `shiftL` 8 .|. fromIntegral b + +integerToBytes :: Integer -> BS.ByteString +integerToBytes = BS.pack . go + where + go c = case c of + 0 -> [] + c -> go (c `div` 256) ++ [fromIntegral (c `mod` 256)] + +zeroPad :: Integer -> BS.ByteString -> BS.ByteString +zeroPad n s = BS.append padding s + where + padding = BS.pack (replicate (fromIntegral n - fromIntegral (BS.length s)) 0) + +toBytes32 :: Integer -> BS.ByteString +toBytes32 = zeroPad 32 . integerToBytes + +hash256 :: BS.ByteString -> BS.ByteString +hash256 = SHA256.hash . SHA256.hash + +sighash :: BS.ByteString -> NField +sighash = fromIntegral . fromBytes . hash256 + +-- priv = fromIntegral $ fromBytes $ hash256 "my secret" :: NField +priv = 12345 +mesg = fromIntegral $ fromBytes $ hash256 "Programming Bitcoin!" :: NField +k = 1234567890 :: NField +rm = scalarProduct (asInt k) gcons +sm = (mesg + fromIntegral (asInt (x rm)) * priv) / k +pubm = scalarProduct (asInt priv) gcons + +signMessage :: NField -> BS.ByteString -> Signature +signMessage priv mesg = + let z = sighash mesg + k = deterministicK priv z + rm = scalarProduct (asInt k) gcons + FieldElement sm = (z + fromIntegral (asInt (x rm)) * priv) / k + ss = if sm > (div ncons 2) then ncons - sm else sm + in Signature (x rm) (fromIntegral ss) + +deterministicK :: NField -> NField -> NField +deterministicK priv (FieldElement z) = fromInteger $ candidate k2 v2 + where + k = BS.pack $ replicate 32 0 + v = BS.pack $ replicate 32 1 + zbs = toBytes32 z + FieldElement sk = priv + skbs = toBytes32 sk + k1 = SHA256.hmac k $ v `BS.append` "\NUL" `BS.append` skbs `BS.append` zbs + v1 = SHA256.hmac k1 v + k2 = SHA256.hmac k1 $ v1 `BS.append` "\SOH" `BS.append` skbs `BS.append` zbs + v2 = SHA256.hmac k2 v1 + + candidate k v = + let vNew = SHA256.hmac k v + can = fromBytes vNew + in if can >= 1 && can < ncons + then can + else + let kp = SHA256.hmac k $ vNew `BS.append` "\NUL" + vp = SHA256.hmac kp vNew + in candidate kp vp |