From 83563cefaf21f0ef40e67cf579dd235f9a67d44f Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 17 Dec 2013 19:36:12 -0500 Subject: Bitcoin foo --- kiki.hs | 67 +++++++++++++++++++++++++++++++++++++++++++++-------------------- 1 file 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 -- cgit v1.2.3