diff options
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 61 |
1 files changed, 49 insertions, 12 deletions
@@ -30,8 +30,8 @@ import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1' ) | |||
30 | import Data.ASN1.BinaryEncoding ( DER(..) ) | 30 | import Data.ASN1.BinaryEncoding ( DER(..) ) |
31 | import Data.Time.Clock.POSIX ( getPOSIXTime ) | 31 | import Data.Time.Clock.POSIX ( getPOSIXTime ) |
32 | import qualified Data.Map as Map | 32 | import qualified Data.Map as Map |
33 | import qualified Data.ByteString.Lazy as L ( null, readFile, ByteString ) | 33 | import qualified Data.ByteString.Lazy as L ( null, readFile, ByteString, toChunks ) |
34 | import qualified Data.ByteString as S ( unpack ) | 34 | import qualified Data.ByteString as S ( unpack, splitAt, concat, cons ) |
35 | import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break ) | 35 | import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break ) |
36 | import qualified Crypto.Types.PubKey.ECC as ECC | 36 | import qualified Crypto.Types.PubKey.ECC as ECC |
37 | import qualified Codec.Binary.Base32 as Base32 | 37 | import 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 ) |
41 | import System.Posix.Types (EpochTime) | 41 | import System.Posix.Types (EpochTime) |
42 | import System.Posix.Files ( modificationTime, getFileStatus ) | 42 | import System.Posix.Files ( modificationTime, getFileStatus ) |
43 | import System.IO (hPutStrLn,withFile,IOMode(..)) | ||
44 | import Data.Binary ( encode ) | ||
43 | 45 | ||
44 | import qualified CryptoCoins as CryptoCoins | 46 | import qualified CryptoCoins as CryptoCoins |
45 | import Base58 | 47 | import Base58 |
@@ -596,18 +598,53 @@ getCryptoCoinTag p | isSignaturePacket p = do | |||
596 | getCryptoCoinTag _ = Nothing | 598 | getCryptoCoinTag _ = Nothing |
597 | 599 | ||
598 | 600 | ||
601 | coinKeysOwnedBy :: KeyDB -> Maybe Packet -> [(CryptoCoins.CoinNetwork,MappedPacket)] | ||
602 | coinKeysOwnedBy 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 | |||
612 | walletImportFormat 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 | |||
599 | writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)]) | 622 | writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)]) |
600 | writeWalletKeys krd db wk = do | 623 | writeWalletKeys 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 | ||
612 | runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a) | 649 | runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a) |
613 | runKeyRing keyring op = do | 650 | runKeyRing keyring op = do |