aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--programmingbitcoin.cabal47
-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
diff --git a/ecc.hs b/src/Ecc.hs
index 19fe1a0..7523afb 100644
--- a/ecc.hs
+++ b/src/Ecc.hs
@@ -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