diff options
author | joe <joe@jerkface.net> | 2013-12-15 22:05:14 -0500 |
---|---|---|
committer | joe <joe@jerkface.net> | 2013-12-15 22:05:14 -0500 |
commit | dc5415658375e715f3ddaadd2f1e5b3c336b9aae (patch) | |
tree | dfc90cf39a7e4412181c4e2cc5d508ff4983a7ab /kiki.hs | |
parent | e5275d82b9858d446b04efefb690da8553ee96d0 (diff) |
more bitcoin work
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 185 |
1 files changed, 78 insertions, 107 deletions
@@ -71,105 +71,18 @@ import Data.Monoid ((<>)) | |||
71 | -- import Data.X509 | 71 | -- import Data.X509 |
72 | import qualified Data.Map as Map | 72 | import qualified Data.Map as Map |
73 | import DotLock | 73 | import DotLock |
74 | import Codec.Crypto.ECC.Base | 74 | import Codec.Crypto.ECC.Base -- hecc package |
75 | import Text.Printf | 75 | import Text.Printf |
76 | import Math.NumberTheory.Moduli | ||
76 | 77 | ||
77 | 78 | ||
78 | instance Default S.ByteString where def = S.empty | 79 | -- instance Default S.ByteString where def = S.empty |
79 | 80 | ||
80 | isBitCoinKey p = | 81 | isBitCoinKey p = |
81 | isKey p && key_algorithm p == ECDSA && ecc_curve p == oidToDER secp256k1_oid | 82 | and [ isKey p |
82 | 83 | , key_algorithm p == ECDSA | |
83 | {- | 84 | , lookup 'c' (key p) == Just (MPI 0x2b8104000a) -- secp256k1 |
84 | sign seckeys dta hashalgo keyid timestamp g = r | 85 | ] |
85 | where | ||
86 | Message ks = seckeys | ||
87 | ks' = catMaybes $ map (\k->find_key fingerprint (Message [k]) keyid) ks | ||
88 | r = case ks' of | ||
89 | [k] | isBitCoinKey k -> btc_sign (Message [k]) dta hashalgo keyid timestamp g | ||
90 | [k] -> Stephen.sign (Message [k]) dta hashalgo keyid timestamp g | ||
91 | ks -> error $ "cannot determine a key to sign with" | ||
92 | -} | ||
93 | |||
94 | {- | ||
95 | btc_sign :: (CryptoRandomGen g) => | ||
96 | OpenPGP.Message -- ^ SecretKeys, one of which will be used | ||
97 | -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet | ||
98 | -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature | ||
99 | -> String -- ^ KeyID of key to choose | ||
100 | -> Integer -- ^ Timestamp for signature (unless sig supplied) | ||
101 | -> g -- ^ Random number generator | ||
102 | -> (OpenPGP.SignatureOver, g) | ||
103 | -} | ||
104 | btc_sign keys over hsh keyid timestamp g = (over {OpenPGP.signatures_over = [sig]}, g') | ||
105 | where | ||
106 | (final, g') = case OpenPGP.key_algorithm sig of | ||
107 | -- OpenPGP.DSA -> ([dsaR, dsaS], dsaG) | ||
108 | OpenPGP.ECDSA -> ([ecdsaR,ecdsaS],ecdsaG) | ||
109 | kalgo -- | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> ([toNum rsaFinal], g) | ||
110 | | otherwise -> | ||
111 | error ("Unsupported key algorithm " ++ show kalgo ++ "in sign") | ||
112 | Right ((ecdsaR,ecdsaS),ecdsaG) = todo | ||
113 | sig = todo | ||
114 | where | ||
115 | _ = todo -- ECDSA.sign g | ||
116 | {- | ||
117 | Right ((dsaR,dsaS),dsaG) = let k' = privateDSAkey k in | ||
118 | DSA.sign g (dsaTruncate k' . bhash) k' dta | ||
119 | Right rsaFinal = RSA.sign bhash padding (privateRSAkey k) dta | ||
120 | dsaTruncate (DSA.PrivateKey (_,_,q) _) = BS.take (integerBytesize q) | ||
121 | dta = toStrictBS $ encode over `LZ.append` OpenPGP.trailer sig | ||
122 | sig = findSigOrDefault (listToMaybe $ OpenPGP.signatures_over over) | ||
123 | padding = emsa_pkcs1_v1_5_hash_padding hsh | ||
124 | bhash = fst . pgpHash hsh . toLazyBS | ||
125 | toNum = BS.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0 | ||
126 | Just k = find_key keys keyid | ||
127 | |||
128 | -- Either a SignaturePacket was found, or we need to make one | ||
129 | findSigOrDefault (Just s) = OpenPGP.signaturePacket | ||
130 | (OpenPGP.version s) | ||
131 | (OpenPGP.signature_type s) | ||
132 | (OpenPGP.key_algorithm k) -- force to algo of key | ||
133 | hsh -- force hash algorithm | ||
134 | (OpenPGP.hashed_subpackets s) | ||
135 | (OpenPGP.unhashed_subpackets s) | ||
136 | (OpenPGP.hash_head s) | ||
137 | (map OpenPGP.MPI final) | ||
138 | findSigOrDefault Nothing = OpenPGP.signaturePacket | ||
139 | 4 | ||
140 | defaultStype | ||
141 | (OpenPGP.key_algorithm k) -- force to algo of key | ||
142 | hsh | ||
143 | ([ | ||
144 | -- Do we really need to pass in timestamp just for the default? | ||
145 | OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp, | ||
146 | OpenPGP.IssuerPacket $ fingerprint k | ||
147 | ] ++ (case over of | ||
148 | OpenPGP.KeySignature {} -> [OpenPGP.KeyFlagsPacket { | ||
149 | OpenPGP.certify_keys = True, | ||
150 | OpenPGP.sign_data = True, | ||
151 | OpenPGP.encrypt_communication = False, | ||
152 | OpenPGP.encrypt_storage = False, | ||
153 | OpenPGP.split_key = False, | ||
154 | OpenPGP.authentication = False, | ||
155 | OpenPGP.group_key = False | ||
156 | }] | ||
157 | _ -> [] | ||
158 | )) | ||
159 | [] | ||
160 | 0 -- TODO | ||
161 | (map OpenPGP.MPI final) | ||
162 | |||
163 | defaultStype = case over of | ||
164 | OpenPGP.DataSignature ld _ | ||
165 | | OpenPGP.format ld == 'b' -> 0x00 | ||
166 | | otherwise -> 0x01 | ||
167 | OpenPGP.KeySignature {} -> 0x1F | ||
168 | OpenPGP.SubkeySignature {} -> 0x18 | ||
169 | OpenPGP.CertificationSignature {} -> 0x13 | ||
170 | -} | ||
171 | |||
172 | |||
173 | 86 | ||
174 | 87 | ||
175 | warn str = hPutStrLn stderr str | 88 | warn str = hPutStrLn stderr str |
@@ -348,7 +261,7 @@ secretToPublic pkt@(SecretKeyPacket {}) = | |||
348 | PublicKeyPacket { version = version pkt | 261 | PublicKeyPacket { version = version pkt |
349 | , timestamp = timestamp pkt | 262 | , timestamp = timestamp pkt |
350 | , key_algorithm = key_algorithm pkt | 263 | , key_algorithm = key_algorithm pkt |
351 | , ecc_curve = ecc_curve pkt | 264 | -- , ecc_curve = ecc_curve pkt |
352 | , key = let seckey = key pkt | 265 | , key = let seckey = key pkt |
353 | pubs = public_key_fields (key_algorithm pkt) | 266 | pubs = public_key_fields (key_algorithm pkt) |
354 | in filter (\(k,v) -> k `elem` pubs) seckey | 267 | in filter (\(k,v) -> k `elem` pubs) seckey |
@@ -556,6 +469,10 @@ fpmatch grip key = | |||
556 | 469 | ||
557 | listKeys pkts = listKeysFiltered [] pkts | 470 | listKeys pkts = listKeysFiltered [] pkts |
558 | 471 | ||
472 | ecc_curve k = printf "%x" num :: String | ||
473 | where unmpi (MPI num) = num | ||
474 | num = maybe 0 unmpi $ lookup 'c' (key k) | ||
475 | |||
559 | listKeysFiltered grips pkts = do | 476 | listKeysFiltered grips pkts = do |
560 | let (certs,bs) = getBindings pkts | 477 | let (certs,bs) = getBindings pkts |
561 | as = accBindings bs | 478 | as = accBindings bs |
@@ -595,8 +512,13 @@ listKeysFiltered grips pkts = do | |||
595 | , " " | 512 | , " " |
596 | , fingerprint sub | 513 | , fingerprint sub |
597 | -- , " " ++ torhash | 514 | -- , " " ++ torhash |
515 | -- , " " ++ (concatMap (printf "%02X") $ S.unpack (ecc_curve sub)) | ||
598 | ] -- ++ ppShow hashed | 516 | ] -- ++ ppShow hashed |
599 | : showsigs claimants | 517 | : if isBitCoinKey sub |
518 | -- then (" " ++ "B⃦ " ++ bitcoinAddress sub) : showsigs claimants | ||
519 | -- then (" " ++ "BTC " ++ bitcoinAddress sub) : showsigs claimants | ||
520 | then (" " ++ "¢ bitcoin:" ++ bitcoinAddress sub) : showsigs claimants | ||
521 | else showsigs claimants | ||
600 | torkeys = do | 522 | torkeys = do |
601 | (code,(top,sub), kind, hashed,claimants) <- subs | 523 | (code,(top,sub), kind, hashed,claimants) <- subs |
602 | guard ("tor" `elem` kind) | 524 | guard ("tor" `elem` kind) |
@@ -718,7 +640,7 @@ readPacketsFromFile fname = do | |||
718 | return $ | 640 | return $ |
719 | case decodeOrFail input of | 641 | case decodeOrFail input of |
720 | Right (_,_,msg ) -> msg | 642 | Right (_,_,msg ) -> msg |
721 | Left (_,_,_) -> Message [] | 643 | Left (_,_,_) -> trace (fname++": read fail") $ Message [] |
722 | 644 | ||
723 | lockFiles fs = do | 645 | lockFiles fs = do |
724 | let dolock f = do | 646 | let dolock f = do |
@@ -962,7 +884,7 @@ readKeyFromFile False "PEM" fname = do | |||
962 | ,('q',rsaP rsa) -- Note: p & q swapped | 884 | ,('q',rsaP rsa) -- Note: p & q swapped |
963 | ,('u',rsaCoefficient rsa) | 885 | ,('u',rsaCoefficient rsa) |
964 | ] | 886 | ] |
965 | , ecc_curve = def | 887 | -- , ecc_curve = def |
966 | , s2k_useage = 0 | 888 | , s2k_useage = 0 |
967 | , s2k = S2K 100 "" | 889 | , s2k = S2K 100 "" |
968 | , symmetric_algorithm = Unencrypted | 890 | , symmetric_algorithm = Unencrypted |
@@ -1049,7 +971,7 @@ keykey key = | |||
1049 | -- Note: The key's timestamp is included in it's fingerprint. | 971 | -- Note: The key's timestamp is included in it's fingerprint. |
1050 | -- Therefore, the same key with a different timestamp is | 972 | -- Therefore, the same key with a different timestamp is |
1051 | -- considered distinct using this keykey implementation. | 973 | -- considered distinct using this keykey implementation. |
1052 | fingerprint_material key -- TODO: smaller key? | 974 | fingerprint_material (key {timestamp=0}) -- TODO: smaller key? |
1053 | 975 | ||
1054 | 976 | ||
1055 | 977 | ||
@@ -1227,7 +1149,7 @@ showPacket :: Packet -> String | |||
1227 | showPacket p | isKey p = (if is_subkey p | 1149 | showPacket p | isKey p = (if is_subkey p |
1228 | then showPacket0 p | 1150 | then showPacket0 p |
1229 | else ifSecret p "----Secret-----" "----Public-----") | 1151 | else ifSecret p "----Secret-----" "----Public-----") |
1230 | ++ " "++ fingerprint p | 1152 | ++ " "++show (key_algorithm p)++" "++fingerprint p |
1231 | | isUserID p = showPacket0 p ++ " " ++ show (uidkey p) | 1153 | | isUserID p = showPacket0 p ++ " " ++ show (uidkey p) |
1232 | | otherwise = showPacket0 p | 1154 | | otherwise = showPacket0 p |
1233 | showPacket0 p = concat . take 1 $ words (show p) | 1155 | showPacket0 p = concat . take 1 $ words (show p) |
@@ -1338,7 +1260,11 @@ show_wk secring_file grip db = do | |||
1338 | 1260 | ||
1339 | show_all db = do | 1261 | show_all db = do |
1340 | let Message packets = flattenKeys True db | 1262 | let Message packets = flattenKeys True db |
1263 | -- let ks = filter isKey packets | ||
1264 | -- forM_ ks (warn . showPacket) | ||
1265 | -- warn $ "BEGIN LIST "++show (length packets)++" packets." | ||
1341 | putStrLn $ listKeys packets | 1266 | putStrLn $ listKeys packets |
1267 | -- warn $ "END LIST "++show (length packets)++" packets." | ||
1342 | 1268 | ||
1343 | show_pem keyspec wkgrip db = do | 1269 | show_pem keyspec wkgrip db = do |
1344 | let s = parseSpec wkgrip keyspec | 1270 | let s = parseSpec wkgrip keyspec |
@@ -1478,6 +1404,8 @@ findTag tag wk subkey subsigs = (xs',minsig,ys') | |||
1478 | isNotation _ = False | 1404 | isNotation _ = False |
1479 | return (tag `elem` ks, sig) | 1405 | return (tag `elem` ks, sig) |
1480 | 1406 | ||
1407 | applyCurve curve x = x*x*x + x*a + b where (a,b)=(geta curve,getb curve) | ||
1408 | |||
1481 | secp256k1_oid = [1,3,132,0,10] | 1409 | secp256k1_oid = [1,3,132,0,10] |
1482 | secp256k1_curve = ECi l a b p r | 1410 | secp256k1_curve = ECi l a b p r |
1483 | where | 1411 | where |
@@ -1566,15 +1494,51 @@ oidToDER ns = S.pack $ b1 : concatMap encode ys | |||
1566 | (xs,ys) = splitAt 2 ns | 1494 | (xs,ys) = splitAt 2 ns |
1567 | b1 = fromIntegral $ foldl' (\a b->a*40+b) 0 xs | 1495 | b1 = fromIntegral $ foldl' (\a b->a*40+b) 0 xs |
1568 | encode x | x <= 127 = [fromIntegral x] | 1496 | encode x | x <= 127 = [fromIntegral x] |
1569 | | otherwise = map (0x80 .|.) (base128 x) | 1497 | | otherwise = (\(x:xs)-> reverse (x:map (0x80 .|.) xs)) |
1570 | base128 n = reverse $ unfoldr getbyte n | 1498 | (base128r x) |
1499 | base128r n = unfoldr getbyte n | ||
1571 | where | 1500 | where |
1572 | getbyte d = do | 1501 | getbyte d = do |
1573 | guard (d/=0) | 1502 | guard (d/=0) |
1574 | let (q,b) = d `divMod` 128 | 1503 | let (q,b) = d `divMod` 128 |
1575 | return (fromIntegral b,q) | 1504 | return (fromIntegral b,q) |
1576 | 1505 | ||
1506 | nistp256=[1,2,840,10045,3,1,7] | ||
1507 | nistp256_der=[0x2A,0x86,0x48,0xCE,0x3D,0x03,0x01,0x07] | ||
1508 | -- "\x2a\x86\x48\xce\x3d\x03\x01\x07" | ||
1509 | {- OID Curve description Curve name | ||
1510 | ---------------------------------------------------------------- | ||
1511 | 1.2.840.10045.3.1.7 NIST Curve P-256 [FIPS 186-2] "NIST P-256" | ||
1512 | 1.3.132.0.34 NIST Curve P-384 [FIPS 186-2] "NIST P-384" | ||
1513 | 1.3.132.0.35 NIST Curve P-521 [FIPS 186-2] "NIST P-521" | ||
1514 | |||
1515 | Implementations MUST implement "NIST P-256", "NIST P-384" and "NIST | ||
1516 | P-521". The hexadecimal representation used in the public and | ||
1517 | private key encodings are: | ||
1518 | |||
1519 | Curve Name Len Hexadecimal representation of the OID | ||
1520 | ---------------------------------------------------------------- | ||
1521 | "NIST P-256" 8 0x2A, 0x86, 0x48, 0xCE, 0x3D, 0x03, 0x01, 0x07 | ||
1522 | "NIST P-384" 6 0x05, 0x2B, 0x81, 0x04, 0x00, 0x22 | ||
1523 | "NIST P-521" 6 0x05, 0x2B, 0x81, 0x04, 0x00, 0x23 | ||
1524 | -} | ||
1525 | |||
1526 | bitcoinAddress k = address | ||
1527 | where | ||
1528 | Just (MPI x) = lookup 'x' (key k) | ||
1529 | Just (MPI y) = lookup 'y' (key k) | ||
1530 | pub = cannonical_eckey x y | ||
1531 | network_id = 0 -- main network | ||
1532 | hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub | ||
1533 | address = base58_encode hash | ||
1577 | 1534 | ||
1535 | -- gpg supported ECDSA curve: 2A8648CE3D030107 | ||
1536 | -- 2A 86 48 CE 3D 03 01 07 | ||
1537 | -- 1,2,134,72,206,61,3,1,7 | ||
1538 | -- 6*128+0x48 840 | ||
1539 | -- 0x4e*128+0x3d 10045 | ||
1540 | -- 1.2.840.10045.3.1.7 --> NIST P-256 | ||
1541 | -- | ||
1578 | decode_btc_key str = do | 1542 | decode_btc_key str = do |
1579 | timestamp <- now | 1543 | timestamp <- now |
1580 | return $ Message $ do | 1544 | return $ Message $ do |
@@ -1583,6 +1547,9 @@ decode_btc_key str = do | |||
1583 | xy = secp256k1_G `pmul` d | 1547 | xy = secp256k1_G `pmul` d |
1584 | x = getx xy | 1548 | x = getx xy |
1585 | y = gety xy | 1549 | y = gety xy |
1550 | -- y² = x³ + 7 (mod p) | ||
1551 | y' = sqrtModP' (applyCurve secp256k1_curve x) (getp secp256k1_curve) | ||
1552 | y'' = sqrtModPList (applyCurve secp256k1_curve x) (getp secp256k1_curve) | ||
1586 | pub = cannonical_eckey x y | 1553 | pub = cannonical_eckey x y |
1587 | network_id = 0 -- main network | 1554 | network_id = 0 -- main network |
1588 | hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub | 1555 | hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub |
@@ -1590,14 +1557,18 @@ decode_btc_key str = do | |||
1590 | pubstr = concatMap (printf "%02x") $ pub | 1557 | pubstr = concatMap (printf "%02x") $ pub |
1591 | _ = pubstr :: String | 1558 | _ = pubstr :: String |
1592 | return $ trace (unlines ["pub="++show pubstr | 1559 | return $ trace (unlines ["pub="++show pubstr |
1593 | ,"add="++show address]) SecretKeyPacket | 1560 | ,"add="++show address |
1561 | ,"y ="++show y | ||
1562 | ,"y' ="++show y' | ||
1563 | ,"y''="++show y'']) SecretKeyPacket | ||
1594 | { version = 4 | 1564 | { version = 4 |
1595 | , timestamp = toEnum (fromEnum timestamp) | 1565 | , timestamp = toEnum (fromEnum timestamp) |
1596 | , key_algorithm = ECDSA | 1566 | , key_algorithm = ECDSA |
1597 | , ecc_curve = oidToDER secp256k1_oid | ||
1598 | , key = [ -- public fields... | 1567 | , key = [ -- public fields... |
1599 | ('x',MPI x) | 1568 | ('c',MPI 0x2b8104000a) -- secp256k1 (bitcoin curve) |
1600 | ,('y',MPI y) -- OPTIONAL CACHED y | 1569 | ,('l',MPI 256) |
1570 | ,('x',MPI x) | ||
1571 | ,('y',MPI y) | ||
1601 | -- secret fields | 1572 | -- secret fields |
1602 | ,('d',MPI d) | 1573 | ,('d',MPI d) |
1603 | ] | 1574 | ] |
@@ -1997,7 +1968,7 @@ main = do | |||
1997 | altered = map (second append_loc) to_alters | 1968 | altered = map (second append_loc) to_alters |
1998 | append_loc (KeyData p a b c) = KeyData p' a b c | 1969 | append_loc (KeyData p a b c) = KeyData p' a b c |
1999 | where p' = p { locations = Map.insert pubring | 1970 | where p' = p { locations = Map.insert pubring |
2000 | (origin (packet p) (-1)) | 1971 | (origin (secretToPublic (packet p)) (-1)) |
2001 | (locations p) | 1972 | (locations p) |
2002 | } | 1973 | } |
2003 | dont_have (KeyData p _ _ _) = not . Map.member pubring | 1974 | dont_have (KeyData p _ _ _) = not . Map.member pubring |