summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Base58.hs15
-rw-r--r--KeyRing.hs61
-rw-r--r--kiki.hs23
3 files changed, 64 insertions, 35 deletions
diff --git a/Base58.hs b/Base58.hs
index 26f1cb2..8adf60d 100644
--- a/Base58.hs
+++ b/Base58.hs
@@ -35,3 +35,18 @@ base58_decode str = do
35 guard (hash_result==expected_hash) 35 guard (hash_result==expected_hash)
36 return (network_id,payload) 36 return (network_id,payload)
37 37
38base58_encode :: S.ByteString -> String
39base58_encode hash = replicate zcount '1' ++ map (base58chars !!) (reverse rdigits)
40 where
41 zcount = S.length . S.takeWhile (==0) $ hash
42 cksum = S.take 4 . SHA256.hash . SHA256.hash $ hash
43 n = foldl' (\a b->a*256+b) 0 . map asInteger $ concatMap S.unpack [hash, cksum]
44 asInteger x = fromIntegral x :: Integer
45 rdigits = unfoldr getdigit n
46 where
47 getdigit d = do
48 guard (d/=0)
49 let (q,b) = d `divMod` 58
50 return (fromIntegral b,q)
51
52
diff --git a/KeyRing.hs b/KeyRing.hs
index 2d92c7e..d95db08 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -30,8 +30,8 @@ import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1' )
30import Data.ASN1.BinaryEncoding ( DER(..) ) 30import Data.ASN1.BinaryEncoding ( DER(..) )
31import Data.Time.Clock.POSIX ( getPOSIXTime ) 31import Data.Time.Clock.POSIX ( getPOSIXTime )
32import qualified Data.Map as Map 32import qualified Data.Map as Map
33import qualified Data.ByteString.Lazy as L ( null, readFile, ByteString ) 33import qualified Data.ByteString.Lazy as L ( null, readFile, ByteString, toChunks )
34import qualified Data.ByteString as S ( unpack ) 34import qualified Data.ByteString as S ( unpack, splitAt, concat, cons )
35import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break ) 35import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break )
36import qualified Crypto.Types.PubKey.ECC as ECC 36import qualified Crypto.Types.PubKey.ECC as ECC
37import qualified Codec.Binary.Base32 as Base32 37import qualified Codec.Binary.Base32 as Base32
@@ -40,6 +40,8 @@ import qualified Data.Text as T ( Text, unpack, pack,
40 strip, reverse, drop, break, dropAround ) 40 strip, reverse, drop, break, dropAround )
41import System.Posix.Types (EpochTime) 41import System.Posix.Types (EpochTime)
42import System.Posix.Files ( modificationTime, getFileStatus ) 42import System.Posix.Files ( modificationTime, getFileStatus )
43import System.IO (hPutStrLn,withFile,IOMode(..))
44import Data.Binary ( encode )
43 45
44import qualified CryptoCoins as CryptoCoins 46import qualified CryptoCoins as CryptoCoins
45import Base58 47import Base58
@@ -596,18 +598,53 @@ getCryptoCoinTag p | isSignaturePacket p = do
596getCryptoCoinTag _ = Nothing 598getCryptoCoinTag _ = Nothing
597 599
598 600
601coinKeysOwnedBy :: KeyDB -> Maybe Packet -> [(CryptoCoins.CoinNetwork,MappedPacket)]
602coinKeysOwnedBy db wk = do
603 wk <- maybeToList wk
604 let kk = keykey wk
605 KeyData top topsigs uids subs <- maybeToList $ Map.lookup kk db
606 (subkk,SubKey mp sigs) <- Map.toList subs
607 let sub = packet mp
608 guard $ isCryptoCoinKey sub
609 tag <- take 1 $ mapMaybe getCryptoCoinTag (map (packet . fst) sigs)
610 return (tag,mp)
611
612walletImportFormat idbyte k = secret_base58_foo
613 where
614 -- isSecret (SecretKeyPacket {}) = True
615 -- isSecret _ = False
616 secret_base58_foo = base58_encode seckey
617 Just d = lookup 'd' (key k)
618 (_,bigendian) = S.splitAt 2 (S.concat $ L.toChunks $ encode d)
619 seckey = S.cons idbyte bigendian
620
621
599writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)]) 622writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)])
600writeWalletKeys krd db wk = do 623writeWalletKeys krd db wk = do
601 let all_crypto_keys = do 624 let cs = db `coinKeysOwnedBy` wk
602 wk <- maybeToList wk 625 -- export wallet keys
603 let kk = keykey wk 626 isMutableWallet (MutableRef {}) WalletFile = True
604 KeyData top topsigs uids subs <- maybeToList $ Map.lookup kk db 627 isMutableWallet _ _ = False
605 (subkk,SubKey mp sigs) <- Map.toList subs 628 files pred = do
606 let sub = packet mp 629 (f,(rtyp,ftyp)) <- Map.toList (kFiles krd)
607 guard $ isCryptoCoinKey sub 630 guard (pred rtyp ftyp)
608 tag <- take 1 $ mapMaybe getCryptoCoinTag (map (packet . fst) sigs) 631 resolveInputFile "" "" f
609 return (tag,mp) 632 let writeWallet report n = do
610 return $ KikiSuccess [] 633 let cs' = do
634 (nw,mp) <- cs
635 -- let fns = Map.keys (locations mp)
636 -- trace ("COIN KEY: "++show fns) $ return ()
637 guard . not $ Map.member n (locations mp)
638 let wip = walletImportFormat (CryptoCoins.private_byte_id nw) (packet mp)
639 return (CryptoCoins.network_name nw,wip)
640 handleIO_ (return report) $ do
641 withFile n AppendMode $ \fh -> do
642 rs <- forM cs' $ \(net,wip) -> do
643 hPutStrLn fh wip
644 return (n, NewWalletKey net)
645 return (report ++ rs)
646 report <- foldM writeWallet [] (files isMutableWallet)
647 return $ KikiSuccess report
611 648
612runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a) 649runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a)
613runKeyRing keyring op = do 650runKeyRing keyring op = do
diff --git a/kiki.hs b/kiki.hs
index 9c748e5..4daff67 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1109,29 +1109,6 @@ secp256k1_G = ECPa secp256k1_curve
1109 -} 1109 -}
1110-} 1110-}
1111 1111
1112walletImportFormat idbyte k = secret_base58_foo
1113 where
1114 -- isSecret (SecretKeyPacket {}) = True
1115 -- isSecret _ = False
1116 secret_base58_foo = base58_encode seckey
1117 Just d = lookup 'd' (key k)
1118 (_,bigendian) = S.splitAt 2 (S.concat $ L.toChunks $ encode d)
1119 seckey = S.cons idbyte bigendian
1120
1121
1122base58_encode :: S.ByteString -> String
1123base58_encode hash = replicate zcount '1' ++ map (base58chars !!) (reverse rdigits)
1124 where
1125 zcount = S.length . S.takeWhile (==0) $ hash
1126 cksum = S.take 4 . SHA256.hash . SHA256.hash $ hash
1127 n = foldl' (\a b->a*256+b) 0 . map asInteger $ concatMap S.unpack [hash, cksum]
1128 asInteger x = fromIntegral x :: Integer
1129 rdigits = unfoldr getdigit n
1130 where
1131 getdigit d = do
1132 guard (d/=0)
1133 let (q,b) = d `divMod` 58
1134 return (fromIntegral b,q)
1135 1112
1136cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8] 1113cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8]
1137 where 1114 where