From dc5415658375e715f3ddaadd2f1e5b3c336b9aae Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 15 Dec 2013 22:05:14 -0500 Subject: more bitcoin work --- kiki.hs | 185 +++++++++++++++++++++++++++------------------------------------- 1 file 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 -- cgit v1.2.3