summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--kiki.cabal6
-rw-r--r--kiki.hs306
2 files changed, 300 insertions, 12 deletions
diff --git a/kiki.cabal b/kiki.cabal
index 0a517f0..8ce59a6 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -15,11 +15,13 @@ Executable kiki
15 Main-is: kiki.hs 15 Main-is: kiki.hs
16 Build-Depends: base -any, cmdargs -any, directory -any, 16 Build-Depends: base -any, cmdargs -any, directory -any,
17 openpgp-crypto-api -any, 17 openpgp-crypto-api -any,
18 crypto-pubkey -any, cryptohash -any, 18 crypto-pubkey (>=0.2.3), cryptohash -any,
19 crypto-pubkey-types -any,
19 asn1-types -any, asn1-encoding -any, 20 asn1-types -any, asn1-encoding -any,
20 dataenc -any, text -any, pretty -any, pretty-show -any, 21 dataenc -any, text -any, pretty -any, pretty-show -any,
21 bytestring -any, openpgp (==0.6.1), binary -any, 22 bytestring -any, openpgp (==0.6.1), binary -any,
22 unix, time, crypto-api, cryptocipher (>=0.3.7), 23 unix, time, crypto-api, cryptocipher (>=0.3.7),
23 containers -any, process -any, filepath -any 24 containers -any, process -any, filepath -any,
25 hecc -any
24 ghc-options: -O2 26 ghc-options: -O2
25 c-sources: dotlock.c 27 c-sources: dotlock.c
diff --git a/kiki.hs b/kiki.hs
index 22000d0..6c8ef10 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -14,7 +14,7 @@ import GHC.IO.Exception ( ioException, IOErrorType(..) )
14import Data.IORef 14import Data.IORef
15import Data.Tuple 15import Data.Tuple
16import Data.Binary 16import Data.Binary
17import Data.OpenPGP 17import Data.OpenPGP as OpenPGP
18import qualified Data.ByteString.Lazy as L 18import qualified Data.ByteString.Lazy as L
19import qualified Data.ByteString.Lazy.Char8 as Char8 19import qualified Data.ByteString.Lazy.Char8 as Char8
20import qualified Data.ByteString as S 20import qualified Data.ByteString as S
@@ -23,7 +23,8 @@ import Control.Monad
23import qualified Text.Show.Pretty as PP 23import qualified Text.Show.Pretty as PP
24import Text.PrettyPrint as PP hiding ((<>)) 24import Text.PrettyPrint as PP hiding ((<>))
25import Data.List 25import Data.List
26import Data.OpenPGP.CryptoAPI 26import Data.OpenPGP.CryptoAPI hiding (sign)
27import qualified Data.OpenPGP.CryptoAPI as Stephen (sign)
27import Data.Ord 28import Data.Ord
28import Data.Maybe 29import Data.Maybe
29import Data.Bits 30import Data.Bits
@@ -32,6 +33,12 @@ import Data.Text.Encoding
32import qualified Codec.Binary.Base32 as Base32 33import qualified Codec.Binary.Base32 as Base32
33import qualified Codec.Binary.Base64 as Base64 34import qualified Codec.Binary.Base64 as Base64
34import qualified Crypto.Hash.SHA1 as SHA1 35import qualified Crypto.Hash.SHA1 as SHA1
36import qualified Crypto.Hash.SHA256 as SHA256
37import qualified Crypto.Hash.RIPEMD160 as RIPEMD160
38import qualified Crypto.Types.PubKey.ECC as ECC
39-- import qualified Crypto.Types.PubKey.ECDSA as ECDSA
40-- import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
41
35import Data.Char (toLower) 42import Data.Char (toLower)
36import qualified Crypto.PubKey.RSA as RSA 43import qualified Crypto.PubKey.RSA as RSA
37import Crypto.Random (newGenIO,SystemRandom) 44import Crypto.Random (newGenIO,SystemRandom)
@@ -39,6 +46,8 @@ import Data.ASN1.Types
39import Data.ASN1.Encoding 46import Data.ASN1.Encoding
40import Data.ASN1.BinaryEncoding 47import Data.ASN1.BinaryEncoding
41import Data.ASN1.BitArray 48import Data.ASN1.BitArray
49import qualified Data.Foldable as Foldable
50import qualified Data.Sequence as Sequence
42import Control.Applicative 51import Control.Applicative
43import System.Environment 52import System.Environment
44import System.Directory 53import System.Directory
@@ -54,7 +63,7 @@ import System.IO.Error
54import ControlMaybe 63import ControlMaybe
55import Data.Char 64import Data.Char
56import Control.Arrow (first,second) 65import Control.Arrow (first,second)
57import Data.Traversable hiding (mapM,forM) 66-- import Data.Traversable hiding (mapM,forM)
58import System.Console.CmdArgs 67import System.Console.CmdArgs
59-- import System.Posix.Time 68-- import System.Posix.Time
60import Data.Time.Clock.POSIX 69import Data.Time.Clock.POSIX
@@ -62,6 +71,101 @@ import Data.Monoid ((<>))
62-- import Data.X509 71-- import Data.X509
63import qualified Data.Map as Map 72import qualified Data.Map as Map
64import DotLock 73import DotLock
74import Codec.Crypto.ECC.Base
75import Text.Printf
76
77
78isBitCoinKey p =
79 isKey p && key_algorithm p == ECDSA && ecc_curve p == oidToDER secp256k1_oid
80
81sign seckeys dta hashalgo keyid timestamp g = r
82 where
83 Message ks = seckeys
84 ks' = catMaybes $ map (\k->find_key fingerprint (Message [k]) keyid) ks
85 r = case ks' of
86 [k] | isBitCoinKey k -> btc_sign (Message [k]) dta hashalgo keyid timestamp g
87 [k] -> Stephen.sign (Message [k]) dta hashalgo keyid timestamp g
88 ks -> error $ "cannot determine a key to sign with"
89
90{-
91btc_sign :: (CryptoRandomGen g) =>
92 OpenPGP.Message -- ^ SecretKeys, one of which will be used
93 -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet
94 -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature
95 -> String -- ^ KeyID of key to choose
96 -> Integer -- ^ Timestamp for signature (unless sig supplied)
97 -> g -- ^ Random number generator
98 -> (OpenPGP.SignatureOver, g)
99-}
100btc_sign keys over hsh keyid timestamp g = (over {OpenPGP.signatures_over = [sig]}, g')
101 where
102 (final, g') = case OpenPGP.key_algorithm sig of
103 -- OpenPGP.DSA -> ([dsaR, dsaS], dsaG)
104 OpenPGP.ECDSA -> ([ecdsaR,ecdsaS],ecdsaG)
105 kalgo -- | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> ([toNum rsaFinal], g)
106 | otherwise ->
107 error ("Unsupported key algorithm " ++ show kalgo ++ "in sign")
108 Right ((ecdsaR,ecdsaS),ecdsaG) = todo
109 sig = todo
110 where
111 _ = todo -- ECDSA.sign g
112 {-
113 Right ((dsaR,dsaS),dsaG) = let k' = privateDSAkey k in
114 DSA.sign g (dsaTruncate k' . bhash) k' dta
115 Right rsaFinal = RSA.sign bhash padding (privateRSAkey k) dta
116 dsaTruncate (DSA.PrivateKey (_,_,q) _) = BS.take (integerBytesize q)
117 dta = toStrictBS $ encode over `LZ.append` OpenPGP.trailer sig
118 sig = findSigOrDefault (listToMaybe $ OpenPGP.signatures_over over)
119 padding = emsa_pkcs1_v1_5_hash_padding hsh
120 bhash = fst . pgpHash hsh . toLazyBS
121 toNum = BS.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0
122 Just k = find_key keys keyid
123
124 -- Either a SignaturePacket was found, or we need to make one
125 findSigOrDefault (Just s) = OpenPGP.signaturePacket
126 (OpenPGP.version s)
127 (OpenPGP.signature_type s)
128 (OpenPGP.key_algorithm k) -- force to algo of key
129 hsh -- force hash algorithm
130 (OpenPGP.hashed_subpackets s)
131 (OpenPGP.unhashed_subpackets s)
132 (OpenPGP.hash_head s)
133 (map OpenPGP.MPI final)
134 findSigOrDefault Nothing = OpenPGP.signaturePacket
135 4
136 defaultStype
137 (OpenPGP.key_algorithm k) -- force to algo of key
138 hsh
139 ([
140 -- Do we really need to pass in timestamp just for the default?
141 OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp,
142 OpenPGP.IssuerPacket $ fingerprint k
143 ] ++ (case over of
144 OpenPGP.KeySignature {} -> [OpenPGP.KeyFlagsPacket {
145 OpenPGP.certify_keys = True,
146 OpenPGP.sign_data = True,
147 OpenPGP.encrypt_communication = False,
148 OpenPGP.encrypt_storage = False,
149 OpenPGP.split_key = False,
150 OpenPGP.authentication = False,
151 OpenPGP.group_key = False
152 }]
153 _ -> []
154 ))
155 []
156 0 -- TODO
157 (map OpenPGP.MPI final)
158
159 defaultStype = case over of
160 OpenPGP.DataSignature ld _
161 | OpenPGP.format ld == 'b' -> 0x00
162 | otherwise -> 0x01
163 OpenPGP.KeySignature {} -> 0x1F
164 OpenPGP.SubkeySignature {} -> 0x18
165 OpenPGP.CertificationSignature {} -> 0x13
166 -}
167
168
65 169
66 170
67warn str = hPutStrLn stderr str 171warn str = hPutStrLn stderr str
@@ -240,6 +344,7 @@ secretToPublic pkt@(SecretKeyPacket {}) =
240 PublicKeyPacket { version = version pkt 344 PublicKeyPacket { version = version pkt
241 , timestamp = timestamp pkt 345 , timestamp = timestamp pkt
242 , key_algorithm = key_algorithm pkt 346 , key_algorithm = key_algorithm pkt
347 , ecc_curve = ecc_curve pkt
243 , key = let seckey = key pkt 348 , key = let seckey = key pkt
244 pubs = public_key_fields (key_algorithm pkt) 349 pubs = public_key_fields (key_algorithm pkt)
245 in filter (\(k,v) -> k `elem` pubs) seckey 350 in filter (\(k,v) -> k `elem` pubs) seckey
@@ -604,7 +709,7 @@ expandPath path [] = []
604 709
605readPacketsFromFile :: FilePath -> IO Message 710readPacketsFromFile :: FilePath -> IO Message
606readPacketsFromFile fname = do 711readPacketsFromFile fname = do
607 -- warn $ fname ++ ": reading..." 712 warn $ fname ++ ": reading..."
608 input <- L.readFile fname 713 input <- L.readFile fname
609 return $ 714 return $
610 case decodeOrFail input of 715 case decodeOrFail input of
@@ -853,6 +958,7 @@ readKeyFromFile False "PEM" fname = do
853 ,('q',rsaP rsa) -- Note: p & q swapped 958 ,('q',rsaP rsa) -- Note: p & q swapped
854 ,('u',rsaCoefficient rsa) 959 ,('u',rsaCoefficient rsa)
855 ] 960 ]
961 , ecc_curve = []
856 , s2k_useage = 0 962 , s2k_useage = 0
857 , s2k = S2K 100 "" 963 , s2k = S2K 100 ""
858 , symmetric_algorithm = Unencrypted 964 , symmetric_algorithm = Unencrypted
@@ -948,7 +1054,7 @@ uidkey (UserIDPacket str) = str
948-- Compare master keys, LT is prefered for merging 1054-- Compare master keys, LT is prefered for merging
949keycomp (SecretKeyPacket {}) (PublicKeyPacket {}) = LT 1055keycomp (SecretKeyPacket {}) (PublicKeyPacket {}) = LT
950keycomp (PublicKeyPacket {}) (SecretKeyPacket {}) = GT 1056keycomp (PublicKeyPacket {}) (SecretKeyPacket {}) = GT
951keycomp a b | a==b = EQ 1057keycomp a b | keykey a==keykey b = EQ
952keycomp a b = error $ unlines ["Unable to merge keys:" 1058keycomp a b = error $ unlines ["Unable to merge keys:"
953 , fingerprint a 1059 , fingerprint a
954 , PP.ppShow a 1060 , PP.ppShow a
@@ -959,7 +1065,7 @@ keycomp a b = error $ unlines ["Unable to merge keys:"
959-- Compare subkeys, LT is prefered for merging 1065-- Compare subkeys, LT is prefered for merging
960subcomp (SecretKeyPacket {}) (PublicKeyPacket {}) = LT 1066subcomp (SecretKeyPacket {}) (PublicKeyPacket {}) = LT
961subcomp (PublicKeyPacket {}) (SecretKeyPacket {}) = GT 1067subcomp (PublicKeyPacket {}) (SecretKeyPacket {}) = GT
962subcomp a b | a==b = EQ 1068subcomp a b | keykey a==keykey b = EQ
963subcomp a b = error $ unlines ["Unable to merge subs:" 1069subcomp a b = error $ unlines ["Unable to merge subs:"
964 , fingerprint a 1070 , fingerprint a
965 , PP.ppShow a 1071 , PP.ppShow a
@@ -1368,18 +1474,170 @@ findTag tag wk subkey subsigs = (xs',minsig,ys')
1368 isNotation _ = False 1474 isNotation _ = False
1369 return (tag `elem` ks, sig) 1475 return (tag `elem` ks, sig)
1370 1476
1477secp256k1_oid = [1,3,132,0,10]
1478secp256k1_curve = ECi l a b p r
1479 where
1480 -- y² = x³ + 7 (mod p)
1481 p = 0x0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F
1482 a = 0
1483 b = 7
1484 -- group order (also order of base point G)
1485 r = n
1486 n = 0x0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141
1487 -- cofactor
1488 h = 1
1489 -- bit length
1490 l = 256
1491
1492secp256k1_G = ECPa secp256k1_curve
1493 0x79BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798
1494 0x483ADA7726A3C4655DA4FBFC0E1108A8FD17B448A68554199C47D08FFB10D4B8
1495 {-
1496 The base point G in compressed form is:
1497
1498 G = 02 79BE667E F9DCBBAC 55A06295 CE870B07 029BFCDB 2DCE28D9 59F2815B 16F81798
1499
1500 and in uncompressed form is:
1501
1502 G = 04 79BE667E F9DCBBAC 55A06295 CE870B07 029BFCDB 2DCE28D9 59F2815B 16F81798
1503 483ADA77 26A3C465 5DA4FBFC 0E1108A8 FD17B448 A6855419 9C47D08F FB10D4B8
1504 -}
1505
1506base58chars = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
1507
1508base58digits :: [Char] -> Maybe [Int]
1509base58digits str = sequence mbs
1510 where
1511 mbs = map (flip elemIndex base58chars) str
1512
1513-- 5HueCGU8rMjxEXxiPuD5BDku4MkFqeZyd4dZ1jvhTVqvbTLvyTJ
1514base58_decode :: [Char] -> Maybe (Word8,[Word8])
1515base58_decode str = do
1516 ds <- base58digits str
1517 let n = foldl' (\a b-> a*58 + b) 0 $ ( map fromIntegral ds :: [Integer] )
1518 rbytes = unfoldr getbyte n
1519 getbyte d = do
1520 guard (d/=0)
1521 let (q,b) = d `divMod` 256
1522 return (fromIntegral b,q)
1523
1524 let (rcksum,rpayload) = splitAt 4 $ rbytes
1525 a_payload = reverse rpayload
1526 hash_result = S.take 4 . SHA256.hash . SHA256.hash . S.pack $ a_payload
1527 expected_hash = S.pack $ reverse rcksum
1528 (app,payload) = splitAt 1 a_payload
1529
1530 app <- listToMaybe app
1531 guard (hash_result==expected_hash)
1532 return (app,payload)
1533
1534base58_encode :: S.ByteString -> String
1535base58_encode hash = replicate zcount '1' ++ map (base58chars !!) (reverse rdigits)
1536 where
1537 zcount = S.length . S.takeWhile (==0) $ hash
1538 cksum = S.take 4 . SHA256.hash . SHA256.hash $ hash
1539 n = foldl' (\a b->a*256+b) 0 . map asInteger $ concatMap S.unpack [hash, cksum]
1540 asInteger x = fromIntegral x :: Integer
1541 rdigits = unfoldr getdigit n
1542 where
1543 getdigit d = do
1544 guard (d/=0)
1545 let (q,b) = d `divMod` 58
1546 return (fromIntegral b,q)
1547
1548cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8]
1549 where
1550 numToBytes n = reverse $ unfoldr getbyte n
1551 where
1552 getbyte d = do
1553 guard (d/=0)
1554 let (q,b) = d `divMod` 256
1555 return (fromIntegral b,q)
1556 pad32 xs = replicate zlen 0 ++ xs
1557 where
1558 zlen = 32 - length xs
1559
1560oidToDER ns = b1 : concatMap encode ys :: [Word8]
1561 where
1562 (xs,ys) = splitAt 2 ns
1563 b1 = fromIntegral $ foldl' (\a b->a*40+b) 0 xs
1564 encode x | x <= 127 = [fromIntegral x]
1565 | otherwise = map (0x80 .|.) (base128 x)
1566 base128 n = reverse $ unfoldr getbyte n
1567 where
1568 getbyte d = do
1569 guard (d/=0)
1570 let (q,b) = d `divMod` 128
1571 return (fromIntegral b,q)
1572
1573
1574decode_btc_key str = do
1575 timestamp <- now
1576 return $ Message $ do
1577 (a,us) <- maybeToList $ base58_decode str
1578 let d = foldl' (\a b->a*256+b) 0 (map fromIntegral us :: [Integer])
1579 xy = secp256k1_G `pmul` d
1580 x = getx xy
1581 y = gety xy
1582 pub = cannonical_eckey x y
1583 network_id = 0 -- main network
1584 hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub
1585 address = base58_encode hash
1586 pubstr = concatMap (printf "%02x") $ pub
1587 _ = pubstr :: String
1588 return $ trace (unlines ["pub="++show pubstr
1589 ,"add="++show address]) SecretKeyPacket
1590 { version = 4
1591 , timestamp = toEnum (fromEnum timestamp)
1592 , key_algorithm = ECDSA
1593 , ecc_curve = oidToDER secp256k1_oid
1594 , key = [ -- public fields...
1595 ('x',MPI x)
1596 ,('y',MPI y) -- OPTIONAL CACHED y
1597 -- secret fields
1598 ,('d',MPI d)
1599 ]
1600 , s2k_useage = 0
1601 , s2k = S2K 100 ""
1602 , symmetric_algorithm = Unencrypted
1603 , encrypted_data = ""
1604 , is_subkey = True
1605 }
1606
1607doBTCImport doDecrypt db (ms,subspec,content) = do
1608 let fetchkey = decode_btc_key content
1609 let error s = do
1610 warn s
1611 exitFailure
1612 flip (maybe $ error "Cannot import master key.")
1613 subspec $ \tag -> do
1614 Message parsedkey <- fetchkey
1615 flip (maybe $ return db)
1616 (listToMaybe parsedkey) $ \key -> do
1617 let (m0,tailms) = splitAt 1 ms
1618 when (not (null tailms) || null m0)
1619 $ error "Key specification is ambiguous."
1620 doImportG doDecrypt db m0 tag "" key
1621
1371doImport doDecrypt db (fname,subspec,ms,_) = do 1622doImport doDecrypt db (fname,subspec,ms,_) = do
1623 let fetchkey = readKeyFromFile False "PEM" fname
1372 let error s = do 1624 let error s = do
1373 warn s 1625 warn s
1374 exitFailure 1626 exitFailure
1375 flip (maybe $ error "Cannot import master key.") 1627 flip (maybe $ error "Cannot import master key.")
1376 subspec $ \tag -> do 1628 subspec $ \tag -> do
1377 Message parsedkey <- readKeyFromFile False "PEM" fname 1629 Message parsedkey <- fetchkey
1378 flip (maybe $ return db) 1630 flip (maybe $ return db)
1379 (listToMaybe parsedkey) $ \key -> do 1631 (listToMaybe parsedkey) $ \key -> do
1380 let (m0,tailms) = splitAt 1 ms 1632 let (m0,tailms) = splitAt 1 ms
1381 when (not (null tailms) || null m0) 1633 when (not (null tailms) || null m0)
1382 $ error "Key specification is ambiguous." 1634 $ error "Key specification is ambiguous."
1635 doImportG doDecrypt db m0 tag fname key
1636
1637doImportG doDecrypt db m0 tag fname key = do
1638 let error s = do
1639 warn s
1640 exitFailure
1383 let kk = head m0 1641 let kk = head m0
1384 Just (KeyData top topsigs uids subs) = Map.lookup kk db 1642 Just (KeyData top topsigs uids subs) = Map.lookup kk db
1385 subkk = keykey key 1643 subkk = keykey key
@@ -1635,7 +1893,7 @@ main = do
1635 , ("--show-pem",1) 1893 , ("--show-pem",1)
1636 , ("--help",0) 1894 , ("--help",0)
1637 ] 1895 ]
1638 argspec = map fst sargspec ++ ["--keyrings","--keypairs"] 1896 argspec = map fst sargspec ++ ["--keyrings","--keypairs","--bitcoin-keypairs"]
1639 args' = if map (take 1) (take 1 vargs) == ["-"] 1897 args' = if map (take 1) (take 1 vargs) == ["-"]
1640 then vargs 1898 then vargs
1641 else "--keyrings":vargs 1899 else "--keyrings":vargs
@@ -1663,6 +1921,17 @@ main = do
1663 guard $ take 1 bdmcb == "}" 1921 guard $ take 1 bdmcb == "}"
1664 let cmd = (drop 1 . reverse . drop 1) bdmcb 1922 let cmd = (drop 1 . reverse . drop 1) bdmcb
1665 Just (spec,file,cmd) 1923 Just (spec,file,cmd)
1924 btcpairs0 =
1925 flip map (maybe [] id $ Map.lookup "--bitcoin-keypairs" margs) $ \specfile -> do
1926 let (spec,efilecmd) = break (=='=') specfile
1927 (spec,protocnt) <- do
1928 return $ if take 1 efilecmd=="=" then (spec,drop 1 efilecmd)
1929 else ("",spec)
1930 let (proto,content) = break (==':') protocnt
1931 spec <- return $ if null spec then "bitcoin" else spec
1932 return $
1933 if take 1 content =="=" then (spec,proto,drop 1 content)
1934 else (spec,"base58",proto)
1666 publics = 1935 publics =
1667 flip map (maybe [] id $ Map.lookup "--public" margs) $ \specfile -> do 1936 flip map (maybe [] id $ Map.lookup "--public" margs) $ \specfile -> do
1668 let (spec,efile) = break (=='=') specfile 1937 let (spec,efile) = break (=='=') specfile
@@ -1699,6 +1968,7 @@ main = do
1699 exitFailure 1968 exitFailure
1700 1969
1701 let keypairs = catMaybes keypairs0 1970 let keypairs = catMaybes keypairs0
1971 btcpairs = catMaybes btcpairs0
1702 1972
1703 (homedir,secring,pubring,grip0) <- getHomeDir ( concat <$> Map.lookup "--homedir" margs) 1973 (homedir,secring,pubring,grip0) <- getHomeDir ( concat <$> Map.lookup "--homedir" margs)
1704 1974
@@ -1734,8 +2004,8 @@ main = do
1734 use_db0 <- get_use_db 2004 use_db0 <- get_use_db
1735 2005
1736 let pkeypairs = maybe [] id $ do 2006 let pkeypairs = maybe [] id $ do
1737 g <- grip 2007 keygrip <- grip
1738 return $ map (\(spec,f,cmd)-> (parseSpec g spec,f,cmd)) keypairs 2008 return $ map (\(spec,f,cmd)-> (parseSpec keygrip spec,f,cmd)) keypairs
1739 fs <- forM pkeypairs $ \((topspec,subspec),f,cmd) -> do 2009 fs <- forM pkeypairs $ \((topspec,subspec),f,cmd) -> do
1740 -- Note that it's important to discard the KeyData objects 2010 -- Note that it's important to discard the KeyData objects
1741 -- returned by filterMatches and retain only the keys. 2011 -- returned by filterMatches and retain only the keys.
@@ -1745,8 +2015,24 @@ main = do
1745 f_found <- doesFileExist f 2015 f_found <- doesFileExist f
1746 return (f_found,(f,subspec,ms,cmd)) 2016 return (f_found,(f,subspec,ms,cmd))
1747 2017
2018
1748 let (imports,exports) = partition fst fs 2019 let (imports,exports) = partition fst fs
1749 use_db <- foldM (doImport decrypt) use_db0 (map snd imports) 2020 use_db <- foldM (doImport decrypt) use_db0 (map snd imports)
2021
2022 let (btcs,bad_btcs) = partition isSupportedBTC btcpairs
2023 isSupportedBTC (spec,"base58",cnt) = True
2024 isSupportedBTC _ = False
2025 dblist = Map.toList use_db
2026 pbtcs = maybe [] id $ do
2027 keygrip <- grip
2028 let conv (spec,proto,cnt) =
2029 let (topspec,subspec) = parseSpec keygrip spec
2030 ms = map fst $ filterMatches topspec dblist
2031 in (ms,subspec,cnt)
2032 return $ map conv btcs
2033
2034 use_db <- foldM (doBTCImport decrypt) use_db pbtcs
2035
1750 (ret_db,_) <- foldM (doExport decrypt) (Just use_db,use_db) (map snd exports) 2036 (ret_db,_) <- foldM (doExport decrypt) (Just use_db,use_db) (map snd exports)
1751 2037
1752 use_db <- 2038 use_db <-