aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorÓscar Nájera <hi@oscarnajera.com>2021-07-31 20:48:52 +0200
committerÓscar Nájera <hi@oscarnajera.com>2021-07-31 20:48:52 +0200
commit1558c84963b7277f7d4ed13a79be3ff3a207e996 (patch)
tree2854415a0fdfb2fac8734a42f16153e2787a41c4
parentaa9e4b88e248873a34f0a58b7d3309c1f9992529 (diff)
downloadprogrammingbitcoin-1558c84963b7277f7d4ed13a79be3ff3a207e996.tar.gz
programmingbitcoin-1558c84963b7277f7d4ed13a79be3ff3a207e996.tar.bz2
programmingbitcoin-1558c84963b7277f7d4ed13a79be3ff3a207e996.zip
Organize code to match flow in blogpostHEADmaster
-rw-r--r--programmingbitcoin.cabal36
-rw-r--r--src/Ecc.hs226
2 files changed, 117 insertions, 145 deletions
diff --git a/programmingbitcoin.cabal b/programmingbitcoin.cabal
index 11cda1a..0232710 100644
--- a/programmingbitcoin.cabal
+++ b/programmingbitcoin.cabal
@@ -2,27 +2,6 @@ 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
@@ -30,18 +9,3 @@ library
, 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/src/Ecc.hs b/src/Ecc.hs
index 7523afb..dba6340 100644
--- a/src/Ecc.hs
+++ b/src/Ecc.hs
@@ -28,28 +28,13 @@ instance KnownNat n => Num (FieldElement n) where
instance KnownNat n => Fractional (FieldElement n) where
recip a = a ^ (n - 2) where n = natVal (Proxy :: Proxy n)
- fromRational r = error "cant transform" -- fromInteger (numerator r) / fromInteger (denominator r)
+ fromRational r = error "can't transform" -- fromInteger (numerator r) / fromInteger (denominator r)
instance KnownNat n => Show (FieldElement n) where
show (FieldElement a) | n == (2 ^ 256 - 2 ^ 32 - 977) = printf "0x%064x" a
| otherwise = "FieldElement_" ++ show n ++ " " ++ show a
where n = natVal (Proxy :: Proxy n)
-
-assert :: Bool -> Bool
-assert False = error "WRONG"
-assert x = x
-
-aa =
- let a = FieldElement 2 :: FieldElement 31
- b = FieldElement 15
- in (a + b == FieldElement 17, a /= b, a - b == FieldElement 18)
-
-bb =
- let a = FieldElement 19 :: FieldElement 31
- b = FieldElement 24
- in a * b
-
-- Elliptic curve
data ECPoint a
= Infinity
@@ -61,7 +46,6 @@ data ECPoint a
}
deriving (Eq)
-
instance {-# OVERLAPPABLE #-} (PrintfArg a, Num a) => Show (ECPoint a) where
show Infinity = "ECPoint(Infinity)"
show p = printf "ECPoint(%f, %f)_%f_%f" (x p) (y p) (a p) (b p)
@@ -112,6 +96,113 @@ instance (Eq a, Fractional a) => Semigroup (ECPoint a) where
instance (Eq a, Fractional a) => Monoid (ECPoint a) where
mempty = Infinity
+-- The Bitcoin curve
+type S256Field = FieldElement (2 ^ 256- 2^ 32 - 977)
+type NField
+ = FieldElement
+ 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141
+type S256Point = ECPoint S256Field
+
+s256point :: S256Field -> S256Field -> S256Point
+s256point x y =
+ let p = ECPoint x y 0 7
+ in if validECPoint p then p else error "Invalid point"
+
+ncons = 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141
+gcons = s256point
+ 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798
+ 0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8
+
+-- ECDSA
+data Signature = Signature
+ { r :: S256Field
+ , s :: NField
+ }
+ deriving Show
+
+asInt :: KnownNat n => FieldElement n -> Integer
+asInt (FieldElement n) = n
+
+verifySignanture :: NField -> Signature -> S256Point -> Bool
+verifySignanture z (Signature r s) pub = x target == r
+ where
+ target =
+ scalarProduct (asInt $ z / s) gcons
+ <> scalarProduct (asInt $ fromInteger (asInt r) / s) pub
+
+hash256 :: BS.ByteString -> BS.ByteString
+hash256 = SHA256.hash . SHA256.hash
+
+fromBytes :: BS.ByteString -> Integer
+fromBytes = BS.foldl' f 0 where f a b = a `shiftL` 8 .|. fromIntegral b
+
+sighash :: BS.ByteString -> NField
+sighash = fromInteger . fromBytes . hash256
+
+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
+
+deterministicK :: NField -> NField -> NField
+deterministicK (FieldElement priv) (FieldElement z) = fromInteger
+ $ candidate k2 v2
+ where
+ k = BS.pack $ replicate 32 0
+ v = BS.pack $ replicate 32 1
+ zbs = toBytes32 z
+ skbs = toBytes32 priv
+ 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
+
+signMessage :: NField -> BS.ByteString -> Signature
+signMessage priv mesg =
+ let z = sighash mesg
+ k = deterministicK priv z
+ rm = scalarProduct (asInt k) gcons
+ FieldElement sm = (z + fromInteger (asInt (x rm)) * priv) / k
+ ss = if sm > div ncons 2 then ncons - sm else sm
+ in Signature (x rm) (fromInteger ss)
+
+
+-- TESTs
+-- Finite Fields
+assert :: Bool -> Bool
+assert False = error "WRONG"
+assert x = x
+
+aa =
+ let a = FieldElement 2 :: FieldElement 31
+ b = FieldElement 15
+ in (a + b == FieldElement 17, a /= b, a - b == FieldElement 18)
+
+bb =
+ let a = FieldElement 19 :: FieldElement 31
+ b = FieldElement 24
+ in a * b
+-- Elliptic curves
tre = FieldElement 3 :: FieldElement 31
cc =
let a = ECPoint tre (-7) 5 7
@@ -143,29 +234,14 @@ total = add aPoint $ add aPoint $ add aPoint $ add aPoint aPoint
totalfold = foldr add Infinity $ replicate 5 aPoint
totalmconcat = mconcat $ replicate 5 aPoint
-type S256Field = FieldElement (2 ^ 256- 2^ 32 - 977)
-type NField
- = FieldElement
- 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141
-type S256Point = ECPoint S256Field
-s256point :: S256Field -> S256Field -> S256Point
-s256point x y =
- let p = ECPoint x y 0 7
- in if validECPoint p then p else error "Invalid point"
+-- Bitcoin curve
li :: S256Field
li = 12
ll :: ECPoint (FieldElement 31)
ll = Infinity
ri = ECPoint 3 7 5 7 :: S256Point
-
-ncons = 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141
-gcons = s256point
- 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798
- 0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8
-
-asInt :: KnownNat n => FieldElement n -> Integer
-asInt (FieldElement n) = n
+-- ECDSA
-- z = 0xbc62d4b80d9e36da29c16c5d4d9f11731f36052c72401a76c23c0fb5a9b74423
-- r = 0x37206a0610995c58074999cb9767b87af4c4978db68c06e8e6e81d282047a7c6
@@ -181,13 +257,15 @@ pub = s256point
0x887387e452b8eacc4acfde10d9aaf7f6d9a0f975aabb10d006e4da568744d06c
0x61de6d95231cd89026e286df3b6ae4a894a3378e393e93a0f45b666329a0ae34
-z1 = 0xec208baa0fc1c19f708a9ca96fdeff3ac3f230bb4a7ba4aede4942ad003c0f60
-r1 = 0xac8d1c87e51d0d441be8b3dd5b05c8795b48875dffe00b7ffcfac23010d3a395
+z1 =
+ 0xec208baa0fc1c19f708a9ca96fdeff3ac3f230bb4a7ba4aede4942ad003c0f60 :: NField
+r1 =
+ 0xac8d1c87e51d0d441be8b3dd5b05c8795b48875dffe00b7ffcfac23010d3a395 :: S256Field
s1 =
0x68342ceff8935ededd102dd876ffd6ba72d6a427a3edb13d26eb0781cb423c4 :: NField
-signa1 =
- scalarProduct (asInt $ z1 / s1) gcons <> scalarProduct (asInt $ r1 / s1) pub
+--signa1 =
+ --scalarProduct (asInt $ z1 / s1) gcons <> scalarProduct (asInt $ r1 / s1) pub
z2 =
0x7c076ff316692a3d7eb3c3bb0f8b1488cf72e1afcd929e29307032997a838a3d :: NField
@@ -195,80 +273,10 @@ r2 = 0xeff69ef2b1bd93a66ed5219add4fb51e11a840f404876325a1e8ffe0529a2c :: NField
s2 =
0xc7207fee197d27c618aea621406f6bf5ef6fca38681d82b2f06fddbdce6feab6 :: NField
-
-data Signature = Signature
- { r :: S256Field
- , s :: NField
- } deriving (Show)
-
-verifySignanture :: NField -> Signature -> S256Point -> Bool
-verifySignanture z (Signature r s) pub = x target == r
- where
- target =
- 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
+mesg = sighash "Programming Bitcoin!"
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