summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs61
1 files changed, 49 insertions, 12 deletions
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