Organize code to match flow in blogpostHEADmaster

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