more bitcoin work

1 files changed, 78 insertions, 107 deletions

diff --git a/kiki.hs b/kiki.hs
index ace9077..9f30664 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -71,105 +71,18 @@ import Data.Monoid ((<>))
 -- import Data.X509
 import qualified Data.Map as Map
 import DotLock
-import Codec.Crypto.ECC.Base
+import Codec.Crypto.ECC.Base -- hecc package
 import Text.Printf
+import Math.NumberTheory.Moduli
 
 
-instance Default S.ByteString where def = S.empty
+-- instance Default S.ByteString where def = S.empty
 
 isBitCoinKey p =
-    isKey p && key_algorithm p == ECDSA && ecc_curve p == oidToDER secp256k1_oid
-
-{-
-sign seckeys dta hashalgo keyid timestamp g = r
- where
-    Message ks = seckeys
-    ks' = catMaybes $ map (\k->find_key fingerprint (Message [k]) keyid) ks
-    r = case ks' of
-         [k] | isBitCoinKey k -> btc_sign (Message [k]) dta hashalgo keyid timestamp g
-         [k] -> Stephen.sign (Message [k]) dta hashalgo keyid timestamp g
-         ks  -> error $ "cannot determine a key to sign with"
--}
-
-{-
-btc_sign :: (CryptoRandomGen g) =>
-    OpenPGP.Message          -- ^ SecretKeys, one of which will be used
-    -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet
-    -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature
-    -> String                -- ^ KeyID of key to choose
-    -> Integer               -- ^ Timestamp for signature (unless sig supplied)
-    -> g                     -- ^ Random number generator
-    -> (OpenPGP.SignatureOver, g)
--}
-btc_sign keys over hsh keyid timestamp g = (over {OpenPGP.signatures_over = [sig]}, g')
-    where
-    (final, g') = case OpenPGP.key_algorithm sig of
-        -- OpenPGP.DSA -> ([dsaR, dsaS], dsaG)
-        OpenPGP.ECDSA -> ([ecdsaR,ecdsaS],ecdsaG)
-        kalgo -- | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> ([toNum rsaFinal], g)
-              | otherwise ->
-            error ("Unsupported key algorithm " ++ show kalgo ++ "in sign")
-    Right ((ecdsaR,ecdsaS),ecdsaG) = todo
-    sig = todo
-      where
-        _ = todo -- ECDSA.sign g 
-    {-
-    Right ((dsaR,dsaS),dsaG) = let k' = privateDSAkey k in
-        DSA.sign g (dsaTruncate k' . bhash) k' dta
-    Right rsaFinal = RSA.sign bhash padding (privateRSAkey k) dta
-    dsaTruncate (DSA.PrivateKey (_,_,q) _) = BS.take (integerBytesize q)
-    dta     = toStrictBS $ encode over `LZ.append` OpenPGP.trailer sig
-    sig     = findSigOrDefault (listToMaybe $ OpenPGP.signatures_over over)
-    padding = emsa_pkcs1_v1_5_hash_padding hsh
-    bhash   = fst . pgpHash hsh . toLazyBS
-    toNum   = BS.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0
-    Just k  = find_key keys keyid
-
-    -- Either a SignaturePacket was found, or we need to make one
-    findSigOrDefault (Just s) = OpenPGP.signaturePacket
-        (OpenPGP.version s)
-        (OpenPGP.signature_type s)
-        (OpenPGP.key_algorithm k) -- force to algo of key
-        hsh -- force hash algorithm
-        (OpenPGP.hashed_subpackets s)
-        (OpenPGP.unhashed_subpackets s)
-        (OpenPGP.hash_head s)
-        (map OpenPGP.MPI final)
-    findSigOrDefault Nothing  = OpenPGP.signaturePacket
-        4
-        defaultStype
-        (OpenPGP.key_algorithm k) -- force to algo of key
-        hsh
-        ([
-            -- Do we really need to pass in timestamp just for the default?
-            OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp,
-            OpenPGP.IssuerPacket $ fingerprint k
-        ] ++ (case over of
-            OpenPGP.KeySignature  {} -> [OpenPGP.KeyFlagsPacket {
-                    OpenPGP.certify_keys = True,
-                    OpenPGP.sign_data = True,
-                    OpenPGP.encrypt_communication = False,
-                    OpenPGP.encrypt_storage = False,
-                    OpenPGP.split_key = False,
-                    OpenPGP.authentication = False,
-                    OpenPGP.group_key = False
-                }]
-            _ -> []
-        ))
-        []
-        0 -- TODO
-        (map OpenPGP.MPI final)
-
-    defaultStype = case over of
-        OpenPGP.DataSignature ld _
-            | OpenPGP.format ld == 'b'     -> 0x00
-            | otherwise                    -> 0x01
-        OpenPGP.KeySignature {}           -> 0x1F
-        OpenPGP.SubkeySignature {}        -> 0x18
-        OpenPGP.CertificationSignature {} -> 0x13
-    -}
-
-
+    and [ isKey p
+        , key_algorithm p == ECDSA
+        , lookup 'c' (key p) == Just (MPI 0x2b8104000a) -- secp256k1
+        ]
 
 
 warn str = hPutStrLn stderr str
@@ -348,7 +261,7 @@ secretToPublic pkt@(SecretKeyPacket {}) =
     PublicKeyPacket { version = version pkt
                     , timestamp = timestamp pkt
                     , key_algorithm = key_algorithm pkt
-                    , ecc_curve = ecc_curve pkt
+                    -- , ecc_curve = ecc_curve pkt
                     , key = let seckey = key pkt
                                 pubs = public_key_fields (key_algorithm pkt)
                             in filter (\(k,v) -> k `elem` pubs) seckey
@@ -556,6 +469,10 @@ fpmatch grip key =
 
 listKeys pkts = listKeysFiltered [] pkts
 
+ecc_curve k = printf "%x" num :: String
+ where unmpi (MPI num) = num
+       num =  maybe 0 unmpi $ lookup 'c' (key k)
+
 listKeysFiltered grips pkts = do
     let (certs,bs) = getBindings pkts
         as = accBindings bs
@@ -595,8 +512,13 @@ listKeysFiltered grips pkts = do
                         , " "
                         , fingerprint sub
                         -- , " " ++ torhash
+                        -- , " " ++ (concatMap (printf "%02X") $ S.unpack (ecc_curve sub))
                         ] -- ++ ppShow hashed
-                    :  showsigs claimants
+                    : if isBitCoinKey sub
+                        -- then ("      " ++ "B⃦ " ++ bitcoinAddress sub) : showsigs claimants
+                        -- then ("      " ++ "BTC " ++ bitcoinAddress sub) : showsigs claimants
+                        then ("      " ++ "¢ bitcoin:" ++ bitcoinAddress sub) : showsigs claimants
+                        else showsigs claimants
         torkeys = do
             (code,(top,sub), kind, hashed,claimants) <- subs
             guard ("tor" `elem` kind)
@@ -718,7 +640,7 @@ readPacketsFromFile fname = do
     return $
       case decodeOrFail input of
         Right (_,_,msg ) -> msg
-        Left  (_,_,_)    -> Message []
+        Left  (_,_,_)    -> trace (fname++": read fail") $ Message []
 
 lockFiles fs = do
     let dolock f = do
@@ -962,7 +884,7 @@ readKeyFromFile False "PEM" fname = do
                     ,('q',rsaP rsa) -- Note: p & q swapped
                     ,('u',rsaCoefficient rsa)
                     ]
-            , ecc_curve = def
+            -- , ecc_curve = def
             , s2k_useage = 0
             , s2k = S2K 100 ""
             , symmetric_algorithm = Unencrypted
@@ -1049,7 +971,7 @@ keykey key =
     -- Note: The key's timestamp is included in it's fingerprint.
     --       Therefore, the same key with a different timestamp is
     --       considered distinct using this keykey implementation.
-    fingerprint_material key -- TODO: smaller key?
+    fingerprint_material (key {timestamp=0}) -- TODO: smaller key?
 
 
 
@@ -1227,7 +1149,7 @@ showPacket :: Packet -> String
 showPacket p | isKey p   = (if is_subkey p 
                               then showPacket0 p
                               else ifSecret p "----Secret-----" "----Public-----")
-                           ++ " "++ fingerprint p
+                           ++ " "++show (key_algorithm p)++" "++fingerprint p
              | isUserID p = showPacket0 p ++ " " ++ show (uidkey p)
              | otherwise = showPacket0 p
 showPacket0 p = concat . take 1 $ words (show p)
@@ -1338,7 +1260,11 @@ show_wk secring_file grip db = do
 
 show_all db = do
     let Message packets = flattenKeys True db
+    -- let ks = filter isKey packets
+    -- forM_ ks (warn . showPacket)
+    -- warn $ "BEGIN LIST "++show (length packets)++" packets."
     putStrLn $ listKeys packets
+    -- warn $ "END   LIST "++show (length packets)++" packets."
 
 show_pem keyspec wkgrip db = do
     let s = parseSpec wkgrip keyspec
@@ -1478,6 +1404,8 @@ findTag tag wk subkey subsigs = (xs',minsig,ys')
                     isNotation _ = False
                 return (tag `elem` ks, sig)
 
+applyCurve curve x = x*x*x + x*a + b where (a,b)=(geta curve,getb curve)
+
 secp256k1_oid = [1,3,132,0,10]
 secp256k1_curve = ECi l a b p r
  where
@@ -1566,15 +1494,51 @@ oidToDER ns = S.pack $ b1 : concatMap encode ys
     (xs,ys) = splitAt 2 ns
     b1 = fromIntegral $ foldl' (\a b->a*40+b) 0 xs
     encode x | x <= 127  = [fromIntegral x]
-             | otherwise = map (0x80 .|.) (base128 x)
-    base128 n = reverse $ unfoldr getbyte n
+             | otherwise = (\(x:xs)-> reverse (x:map (0x80 .|.) xs)) 
+                            (base128r x)
+    base128r n = unfoldr getbyte n
      where
         getbyte d = do
             guard (d/=0)
             let (q,b) = d `divMod` 128
             return (fromIntegral b,q)
 
+nistp256=[1,2,840,10045,3,1,7]
+nistp256_der=[0x2A,0x86,0x48,0xCE,0x3D,0x03,0x01,0x07]
+-- "\x2a\x86\x48\xce\x3d\x03\x01\x07"
+{-     OID                  Curve description              Curve name
+    ----------------------------------------------------------------   
+    1.2.840.10045.3.1.7  NIST Curve P-256 [FIPS 186-2]  "NIST P-256"
+    1.3.132.0.34         NIST Curve P-384 [FIPS 186-2]  "NIST P-384"  
+    1.3.132.0.35         NIST Curve P-521 [FIPS 186-2]  "NIST P-521"  
+
+    Implementations MUST implement "NIST P-256", "NIST P-384" and "NIST
+    P-521".  The hexadecimal representation used in the public and
+    private key encodings are:
+
+    Curve Name   Len  Hexadecimal representation of the OID
+    ----------------------------------------------------------------   
+    "NIST P-256"  8   0x2A, 0x86, 0x48, 0xCE, 0x3D, 0x03, 0x01, 0x07 
+    "NIST P-384"  6   0x05, 0x2B, 0x81, 0x04, 0x00, 0x22            
+    "NIST P-521"  6   0x05, 0x2B, 0x81, 0x04, 0x00, 0x23          
+-}
+
+bitcoinAddress k = address
+    where
+            Just (MPI x) = lookup 'x' (key k)
+            Just (MPI y) = lookup 'y' (key k)
+            pub = cannonical_eckey x y
+            network_id = 0 -- main network
+            hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $  pub
+            address = base58_encode hash
 
+-- gpg supported ECDSA curve: 2A8648CE3D030107
+-- 2A 86 48 CE 3D 03 01 07 
+-- 1,2,134,72,206,61,3,1,7
+--  6*128+0x48 840
+--  0x4e*128+0x3d 10045
+-- 1.2.840.10045.3.1.7  --> NIST P-256
+--
 decode_btc_key str = do
     timestamp <- now
     return $ Message $ do
@@ -1583,6 +1547,9 @@ decode_btc_key str = do
             xy = secp256k1_G `pmul` d
             x = getx xy
             y = gety xy
+            -- y² = x³ + 7 (mod p)
+            y' = sqrtModP' (applyCurve secp256k1_curve x) (getp secp256k1_curve)
+            y'' = sqrtModPList (applyCurve secp256k1_curve x) (getp secp256k1_curve)
             pub = cannonical_eckey x y
             network_id = 0 -- main network
             hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $  pub
@@ -1590,14 +1557,18 @@ decode_btc_key str = do
             pubstr = concatMap (printf "%02x") $ pub
             _ = pubstr :: String
         return $ trace (unlines ["pub="++show pubstr
-                                ,"add="++show address])  SecretKeyPacket
+                                ,"add="++show address
+                                ,"y  ="++show y
+                                ,"y' ="++show y'
+                                ,"y''="++show y''])  SecretKeyPacket
             { version = 4
             , timestamp = toEnum (fromEnum timestamp)
             , key_algorithm = ECDSA
-            , ecc_curve = oidToDER secp256k1_oid
             , key = [ -- public fields...
-                     ('x',MPI x)
-                    ,('y',MPI y) -- OPTIONAL CACHED y
+                     ('c',MPI 0x2b8104000a) -- secp256k1 (bitcoin curve)
+                    ,('l',MPI 256)
+                    ,('x',MPI x)
+                    ,('y',MPI y)
                     -- secret fields
                     ,('d',MPI d)
                     ]
@@ -1997,7 +1968,7 @@ main = do
                 altered = map (second append_loc) to_alters
                 append_loc (KeyData p a b c) = KeyData p' a b c
                  where p' = p { locations = Map.insert pubring
-                                                       (origin (packet p) (-1))
+                                                       (origin (secretToPublic (packet p)) (-1))
                                                        (locations p) 
                               }
                 dont_have (KeyData p _ _ _) = not . Map.member pubring