diff options
-rw-r--r-- | kiki.hs | 67 |
1 files changed, 47 insertions, 20 deletions
@@ -78,13 +78,16 @@ import Math.NumberTheory.Moduli | |||
78 | 78 | ||
79 | -- instance Default S.ByteString where def = S.empty | 79 | -- instance Default S.ByteString where def = S.empty |
80 | 80 | ||
81 | -- DER-encoded elliptic curve ids | ||
82 | nistp256_id = 0x2a8648ce3d030107 | ||
83 | secp256k1_id = 0x2b8104000a | ||
84 | |||
81 | isBitCoinKey p = | 85 | isBitCoinKey p = |
82 | and [ isKey p | 86 | and [ isKey p |
83 | , key_algorithm p == ECDSA | 87 | , key_algorithm p == ECDSA |
84 | , lookup 'c' (key p) == Just (MPI 0x2b8104000a) -- secp256k1 | 88 | , lookup 'c' (key p) == Just (MPI secp256k1_id) |
85 | ] | 89 | ] |
86 | 90 | ||
87 | |||
88 | warn str = hPutStrLn stderr str | 91 | warn str = hPutStrLn stderr str |
89 | 92 | ||
90 | unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p)) | 93 | unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p)) |
@@ -518,7 +521,7 @@ listKeysFiltered grips pkts = do | |||
518 | : if isBitCoinKey sub | 521 | : if isBitCoinKey sub |
519 | -- then (" " ++ "B⃦ " ++ bitcoinAddress sub) : showsigs claimants | 522 | -- then (" " ++ "B⃦ " ++ bitcoinAddress sub) : showsigs claimants |
520 | -- then (" " ++ "BTC " ++ bitcoinAddress sub) : showsigs claimants | 523 | -- then (" " ++ "BTC " ++ bitcoinAddress sub) : showsigs claimants |
521 | then (" " ++ "¢ bitcoin:" ++ bitcoinAddress sub) : showsigs claimants | 524 | then (" " ++ "¢ bitcoin:" ++ bitcoinAddress 0 sub) : showsigs claimants |
522 | else showsigs claimants | 525 | else showsigs claimants |
523 | torkeys = do | 526 | torkeys = do |
524 | (code,(top,sub), kind, hashed,claimants) <- subs | 527 | (code,(top,sub), kind, hashed,claimants) <- subs |
@@ -1273,7 +1276,7 @@ show_all db = do | |||
1273 | show_pem keyspec wkgrip db = do | 1276 | show_pem keyspec wkgrip db = do |
1274 | let s = parseSpec wkgrip keyspec | 1277 | let s = parseSpec wkgrip keyspec |
1275 | flip (maybe $ warn (keyspec ++ ": not found") >> return ()) | 1278 | flip (maybe $ warn (keyspec ++ ": not found") >> return ()) |
1276 | (selectKey s db) | 1279 | (selectPublicKey s db) |
1277 | $ \k -> do | 1280 | $ \k -> do |
1278 | let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k | 1281 | let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k |
1279 | der = encodeASN1 DER (toASN1 rsa []) | 1282 | der = encodeASN1 DER (toASN1 rsa []) |
@@ -1281,6 +1284,13 @@ show_pem keyspec wkgrip db = do | |||
1281 | putStrLn $ | 1284 | putStrLn $ |
1282 | writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec) | 1285 | writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec) |
1283 | 1286 | ||
1287 | show_wip keyspec wkgrip db = do | ||
1288 | let s = parseSpec wkgrip keyspec | ||
1289 | flip (maybe $ warn (keyspec ++ ": not found") >> return ()) | ||
1290 | (selectSecretKey s db) | ||
1291 | $ \k -> do | ||
1292 | putStrLn $ walletImportFormat 0x80 k | ||
1293 | |||
1284 | parseSpec :: String -> String -> (KeySpec,Maybe String) | 1294 | parseSpec :: String -> String -> (KeySpec,Maybe String) |
1285 | parseSpec grip spec = (topspec,subspec) | 1295 | parseSpec grip spec = (topspec,subspec) |
1286 | where | 1296 | where |
@@ -1460,11 +1470,21 @@ base58_decode str = do | |||
1460 | a_payload = reverse rpayload | 1470 | a_payload = reverse rpayload |
1461 | hash_result = S.take 4 . SHA256.hash . SHA256.hash . S.pack $ a_payload | 1471 | hash_result = S.take 4 . SHA256.hash . SHA256.hash . S.pack $ a_payload |
1462 | expected_hash = S.pack $ reverse rcksum | 1472 | expected_hash = S.pack $ reverse rcksum |
1463 | (app,payload) = splitAt 1 a_payload | 1473 | (network_id,payload) = splitAt 1 a_payload |
1464 | 1474 | ||
1465 | app <- listToMaybe app | 1475 | network_id <- listToMaybe network_id |
1466 | guard (hash_result==expected_hash) | 1476 | guard (hash_result==expected_hash) |
1467 | return (app,payload) | 1477 | return (network_id,payload) |
1478 | |||
1479 | walletImportFormat idbyte k = secret_base58_foo | ||
1480 | where | ||
1481 | isSecret (SecretKeyPacket {}) = True | ||
1482 | isSecret _ = False | ||
1483 | secret_base58_foo = base58_encode seckey | ||
1484 | Just d = lookup 'd' (key k) | ||
1485 | (len16,bigendian) = S.splitAt 2 (S.concat $ L.toChunks $ encode d) | ||
1486 | seckey = S.cons idbyte bigendian | ||
1487 | |||
1468 | 1488 | ||
1469 | base58_encode :: S.ByteString -> String | 1489 | base58_encode :: S.ByteString -> String |
1470 | base58_encode hash = replicate zcount '1' ++ map (base58chars !!) (reverse rdigits) | 1490 | base58_encode hash = replicate zcount '1' ++ map (base58chars !!) (reverse rdigits) |
@@ -1526,12 +1546,11 @@ nistp256_der=[0x2A,0x86,0x48,0xCE,0x3D,0x03,0x01,0x07] | |||
1526 | "NIST P-521" 6 0x05, 0x2B, 0x81, 0x04, 0x00, 0x23 | 1546 | "NIST P-521" 6 0x05, 0x2B, 0x81, 0x04, 0x00, 0x23 |
1527 | -} | 1547 | -} |
1528 | 1548 | ||
1529 | bitcoinAddress k = address | 1549 | bitcoinAddress network_id k = address |
1530 | where | 1550 | where |
1531 | Just (MPI x) = lookup 'x' (key k) | 1551 | Just (MPI x) = lookup 'x' (key k) |
1532 | Just (MPI y) = lookup 'y' (key k) | 1552 | Just (MPI y) = lookup 'y' (key k) |
1533 | pub = cannonical_eckey x y | 1553 | pub = cannonical_eckey x y |
1534 | network_id = 0 -- main network | ||
1535 | hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub | 1554 | hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub |
1536 | address = base58_encode hash | 1555 | address = base58_encode hash |
1537 | 1556 | ||
@@ -1545,7 +1564,7 @@ bitcoinAddress k = address | |||
1545 | decode_btc_key str = do | 1564 | decode_btc_key str = do |
1546 | timestamp <- now | 1565 | timestamp <- now |
1547 | return $ Message $ do | 1566 | return $ Message $ do |
1548 | (a,us) <- maybeToList $ base58_decode str | 1567 | (network_id,us) <- maybeToList $ base58_decode str |
1549 | let d = foldl' (\a b->a*256+b) 0 (map fromIntegral us :: [Integer]) | 1568 | let d = foldl' (\a b->a*256+b) 0 (map fromIntegral us :: [Integer]) |
1550 | xy = secp256k1_G `pmul` d | 1569 | xy = secp256k1_G `pmul` d |
1551 | x = getx xy | 1570 | x = getx xy |
@@ -1554,21 +1573,21 @@ decode_btc_key str = do | |||
1554 | y' = sqrtModP' (applyCurve secp256k1_curve x) (getp secp256k1_curve) | 1573 | y' = sqrtModP' (applyCurve secp256k1_curve x) (getp secp256k1_curve) |
1555 | y'' = sqrtModPList (applyCurve secp256k1_curve x) (getp secp256k1_curve) | 1574 | y'' = sqrtModPList (applyCurve secp256k1_curve x) (getp secp256k1_curve) |
1556 | pub = cannonical_eckey x y | 1575 | pub = cannonical_eckey x y |
1557 | network_id = 0 -- main network | ||
1558 | hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub | 1576 | hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub |
1559 | address = base58_encode hash | 1577 | address = base58_encode hash |
1560 | pubstr = concatMap (printf "%02x") $ pub | 1578 | pubstr = concatMap (printf "%02x") $ pub |
1561 | _ = pubstr :: String | 1579 | _ = pubstr :: String |
1562 | return $ trace (unlines ["pub="++show pubstr | 1580 | return $ {- trace (unlines ["pub="++show pubstr |
1563 | ,"add="++show address | 1581 | ,"add="++show address |
1564 | ,"y ="++show y | 1582 | ,"y ="++show y |
1565 | ,"y' ="++show y' | 1583 | ,"y' ="++show y' |
1566 | ,"y''="++show y'']) SecretKeyPacket | 1584 | ,"y''="++show y'']) -} |
1585 | SecretKeyPacket | ||
1567 | { version = 4 | 1586 | { version = 4 |
1568 | , timestamp = toEnum (fromEnum timestamp) | 1587 | , timestamp = toEnum (fromEnum timestamp) |
1569 | , key_algorithm = ECDSA | 1588 | , key_algorithm = ECDSA |
1570 | , key = [ -- public fields... | 1589 | , key = [ -- public fields... |
1571 | ('c',MPI 0x2b8104000a) -- secp256k1 (bitcoin curve) | 1590 | ('c',MPI secp256k1_id) -- secp256k1 (bitcoin curve) |
1572 | ,('l',MPI 256) | 1591 | ,('l',MPI 256) |
1573 | ,('x',MPI x) | 1592 | ,('x',MPI x) |
1574 | ,('y',MPI y) | 1593 | ,('y',MPI y) |
@@ -1709,7 +1728,9 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do | |||
1709 | (sigpackets 0x19 | 1728 | (sigpackets 0x19 |
1710 | hashed0 | 1729 | hashed0 |
1711 | [IssuerPacket subgrip])) | 1730 | [IssuerPacket subgrip])) |
1712 | SHA1 | 1731 | (if key_algorithm (head parsedkey)==ECDSA |
1732 | then SHA256 | ||
1733 | else SHA1) | ||
1713 | subgrip | 1734 | subgrip |
1714 | let iss = IssuerPacket (fingerprint wk) | 1735 | let iss = IssuerPacket (fingerprint wk) |
1715 | cons_iss back_sig = iss : map EmbeddedSignaturePacket (signatures_over back_sig) | 1736 | cons_iss back_sig = iss : map EmbeddedSignaturePacket (signatures_over back_sig) |
@@ -1866,6 +1887,7 @@ main = do | |||
1866 | , ("--show-wk",0) | 1887 | , ("--show-wk",0) |
1867 | , ("--show-all",0) | 1888 | , ("--show-all",0) |
1868 | , ("--show-pem",1) | 1889 | , ("--show-pem",1) |
1890 | , ("--show-wip",1) | ||
1869 | , ("--help",0) | 1891 | , ("--help",0) |
1870 | ] | 1892 | ] |
1871 | argspec = map fst sargspec ++ ["--keyrings","--keypairs","--bitcoin-keypairs"] | 1893 | argspec = map fst sargspec ++ ["--keyrings","--keypairs","--bitcoin-keypairs"] |
@@ -2036,6 +2058,7 @@ main = do | |||
2036 | let shspec = Map.fromList [("--show-wk", const $ show_wk secfile grip) | 2058 | let shspec = Map.fromList [("--show-wk", const $ show_wk secfile grip) |
2037 | ,("--show-all",const $ show_all) | 2059 | ,("--show-all",const $ show_all) |
2038 | ,("--show-pem",\[x] -> show_pem x $ maybe "" id grip) | 2060 | ,("--show-pem",\[x] -> show_pem x $ maybe "" id grip) |
2061 | ,("--show-wip",\[x] -> show_wip x $ maybe "" id grip) | ||
2039 | ,("--help", \_ _ ->kiki_usage)] | 2062 | ,("--help", \_ _ ->kiki_usage)] |
2040 | shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs | 2063 | shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs |
2041 | 2064 | ||
@@ -2648,11 +2671,15 @@ isTopKey _ = False | |||
2648 | filterMatches :: KeySpec -> [(KeyKey,KeyData)] -> [(KeyKey,KeyData)] | 2671 | filterMatches :: KeySpec -> [(KeyKey,KeyData)] -> [(KeyKey,KeyData)] |
2649 | filterMatches spec ks = filter (matchSpec spec) ks | 2672 | filterMatches spec ks = filter (matchSpec spec) ks |
2650 | 2673 | ||
2651 | selectKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet | 2674 | selectSecretKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet |
2652 | selectKey (spec,mtag) db = do | 2675 | selectSecretKey (spec,mtag) db = selectKey0 False (spec,mtag) db |
2653 | -- Note: Because of the behavior of flattenKeys, | 2676 | |
2654 | -- selectKey cannot return a SecretKeyPacket | 2677 | selectPublicKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet |
2655 | let Message ps = flattenKeys True db | 2678 | selectPublicKey (spec,mtag) db = selectKey0 True (spec,mtag) db |
2679 | |||
2680 | selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet | ||
2681 | selectKey0 wantPublic (spec,mtag) db = do | ||
2682 | let Message ps = flattenKeys wantPublic db | ||
2656 | ys = snd $ seek_key spec ps | 2683 | ys = snd $ seek_key spec ps |
2657 | flip (maybe (listToMaybe ys)) mtag $ \tag -> do | 2684 | flip (maybe (listToMaybe ys)) mtag $ \tag -> do |
2658 | let (subspec,ys1) = (KeyTag y tag,ys1) where y:ys1 = ys | 2685 | let (subspec,ys1) = (KeyTag y tag,ys1) where y:ys1 = ys |