Bitcoin foo

1 files changed, 47 insertions, 20 deletions

diff --git a/kiki.hs b/kiki.hs
index 81ef3ef..a372c4c 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -78,13 +78,16 @@ import Math.NumberTheory.Moduli
 
 -- instance Default S.ByteString where def = S.empty
 
+-- DER-encoded elliptic curve ids
+nistp256_id  = 0x2a8648ce3d030107
+secp256k1_id = 0x2b8104000a
+
 isBitCoinKey p =
     and [ isKey p
         , key_algorithm p == ECDSA
-        , lookup 'c' (key p) == Just (MPI 0x2b8104000a) -- secp256k1
+        , lookup 'c' (key p) == Just (MPI secp256k1_id)
         ]
 
-
 warn str = hPutStrLn stderr str
 
 unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p))
@@ -518,7 +521,7 @@ listKeysFiltered grips pkts = do
                     : if isBitCoinKey sub
                         -- then ("      " ++ "B⃦ " ++ bitcoinAddress sub) : showsigs claimants
                         -- then ("      " ++ "BTC " ++ bitcoinAddress sub) : showsigs claimants
-                        then ("      " ++ "¢ bitcoin:" ++ bitcoinAddress sub) : showsigs claimants
+                        then ("      " ++ "¢ bitcoin:" ++ bitcoinAddress 0 sub) : showsigs claimants
                         else showsigs claimants
         torkeys = do
             (code,(top,sub), kind, hashed,claimants) <- subs
@@ -1273,7 +1276,7 @@ show_all db = do
 show_pem keyspec wkgrip db = do
     let s = parseSpec wkgrip keyspec
     flip (maybe $ warn (keyspec ++ ": not found") >> return ())
-         (selectKey s db)
+         (selectPublicKey s db)
          $ \k -> do
     let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k
         der = encodeASN1 DER (toASN1 rsa [])
@@ -1281,6 +1284,13 @@ show_pem keyspec wkgrip db = do
     putStrLn $
         writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec)
 
+show_wip keyspec wkgrip db = do
+    let s = parseSpec wkgrip keyspec
+    flip (maybe $ warn (keyspec ++ ": not found") >> return ())
+         (selectSecretKey s db)
+         $ \k -> do
+    putStrLn $ walletImportFormat 0x80 k
+
 parseSpec :: String -> String -> (KeySpec,Maybe String)
 parseSpec grip spec = (topspec,subspec)
  where
@@ -1460,11 +1470,21 @@ base58_decode str = do
         a_payload = reverse rpayload
         hash_result = S.take 4 . SHA256.hash . SHA256.hash . S.pack $ a_payload
         expected_hash = S.pack $ reverse rcksum
-        (app,payload) = splitAt 1 a_payload
+        (network_id,payload) = splitAt 1 a_payload
     
-    app <- listToMaybe app
+    network_id <- listToMaybe network_id
     guard (hash_result==expected_hash)
-    return (app,payload)
+    return (network_id,payload)
+
+walletImportFormat idbyte k = secret_base58_foo
+ where
+    isSecret (SecretKeyPacket {}) = True
+    isSecret _                    = False
+    secret_base58_foo = base58_encode seckey
+    Just d = lookup 'd' (key k)
+    (len16,bigendian) = S.splitAt 2 (S.concat $ L.toChunks $ encode d)
+    seckey = S.cons idbyte bigendian
+
 
 base58_encode :: S.ByteString -> String
 base58_encode hash = replicate zcount '1' ++ map (base58chars !!) (reverse rdigits)
@@ -1526,12 +1546,11 @@ nistp256_der=[0x2A,0x86,0x48,0xCE,0x3D,0x03,0x01,0x07]
     "NIST P-521"  6   0x05, 0x2B, 0x81, 0x04, 0x00, 0x23          
 -}
 
-bitcoinAddress k = address
+bitcoinAddress network_id 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
 
@@ -1545,7 +1564,7 @@ bitcoinAddress k = address
 decode_btc_key str = do
     timestamp <- now
     return $ Message $ do
-        (a,us) <- maybeToList $ base58_decode str
+        (network_id,us) <- maybeToList $ base58_decode str
         let d = foldl' (\a b->a*256+b) 0 (map fromIntegral us :: [Integer])
             xy = secp256k1_G `pmul` d
             x = getx xy
@@ -1554,21 +1573,21 @@ decode_btc_key str = do
             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
             address = base58_encode hash
             pubstr = concatMap (printf "%02x") $ pub
             _ = pubstr :: String
-        return $ trace (unlines ["pub="++show pubstr
+        return $ {- trace (unlines ["pub="++show pubstr
                                 ,"add="++show address
                                 ,"y  ="++show y
                                 ,"y' ="++show y'
-                                ,"y''="++show y''])  SecretKeyPacket
+                                ,"y''="++show y'']) -}
+            SecretKeyPacket 
             { version = 4
             , timestamp = toEnum (fromEnum timestamp)
             , key_algorithm = ECDSA
             , key = [ -- public fields...
-                     ('c',MPI 0x2b8104000a) -- secp256k1 (bitcoin curve)
+                     ('c',MPI secp256k1_id) -- secp256k1 (bitcoin curve)
                     ,('l',MPI 256)
                     ,('x',MPI x)
                     ,('y',MPI y)
@@ -1709,7 +1728,9 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do
                                          (sigpackets 0x19
                                                      hashed0
                                                      [IssuerPacket subgrip]))
-                        SHA1
+                        (if key_algorithm (head parsedkey)==ECDSA
+                            then SHA256
+                            else SHA1)
                         subgrip
     let iss = IssuerPacket (fingerprint wk)
         cons_iss back_sig = iss : map EmbeddedSignaturePacket (signatures_over back_sig)
@@ -1866,6 +1887,7 @@ main = do
                                      , ("--show-wk",0)
                                      , ("--show-all",0)
                                      , ("--show-pem",1)
+                                     , ("--show-wip",1)
                                      , ("--help",0)
                                      ]
                           argspec = map fst sargspec ++ ["--keyrings","--keypairs","--bitcoin-keypairs"]
@@ -2036,6 +2058,7 @@ main = do
             let shspec = Map.fromList [("--show-wk", const $ show_wk secfile grip)
                                       ,("--show-all",const $ show_all)
                                       ,("--show-pem",\[x] -> show_pem x $ maybe "" id grip)
+                                      ,("--show-wip",\[x] -> show_wip x $ maybe "" id grip)
                                       ,("--help", \_ _ ->kiki_usage)]
                 shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs
 
@@ -2648,11 +2671,15 @@ isTopKey _ = False
 filterMatches :: KeySpec -> [(KeyKey,KeyData)] -> [(KeyKey,KeyData)]
 filterMatches spec ks = filter (matchSpec spec) ks
 
-selectKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
-selectKey (spec,mtag) db = do
-    -- Note: Because of the behavior of flattenKeys,
-    --       selectKey cannot return a SecretKeyPacket
-    let Message ps = flattenKeys True db
+selectSecretKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
+selectSecretKey (spec,mtag) db = selectKey0 False (spec,mtag) db
+
+selectPublicKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
+selectPublicKey (spec,mtag) db = selectKey0 True (spec,mtag) db
+
+selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
+selectKey0 wantPublic (spec,mtag) db = do
+    let Message ps = flattenKeys wantPublic db
         ys = snd $ seek_key spec ps
     flip (maybe (listToMaybe ys)) mtag $ \tag -> do
     let (subspec,ys1) = (KeyTag y tag,ys1) where y:ys1 = ys