summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--KeyRing.hs45
-rw-r--r--kiki.hs15
2 files changed, 42 insertions, 18 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index d95db08..d3c4c24 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -202,6 +202,9 @@ data KikiResult a = KikiResult
202 202
203keyPacket (KeyData k _ _ _) = packet k 203keyPacket (KeyData k _ _ _) = packet k
204 204
205keyMappedPacket (KeyData k _ _ _) = k
206
207
205usage (NotationDataPacket 208usage (NotationDataPacket
206 { human_readable = True 209 { human_readable = True
207 , notation_name = "usage@" 210 , notation_name = "usage@"
@@ -618,7 +621,6 @@ walletImportFormat idbyte k = secret_base58_foo
618 (_,bigendian) = S.splitAt 2 (S.concat $ L.toChunks $ encode d) 621 (_,bigendian) = S.splitAt 2 (S.concat $ L.toChunks $ encode d)
619 seckey = S.cons idbyte bigendian 622 seckey = S.cons idbyte bigendian
620 623
621
622writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)]) 624writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)])
623writeWalletKeys krd db wk = do 625writeWalletKeys krd db wk = do
624 let cs = db `coinKeysOwnedBy` wk 626 let cs = db `coinKeysOwnedBy` wk
@@ -646,6 +648,30 @@ writeWalletKeys krd db wk = do
646 report <- foldM writeWallet [] (files isMutableWallet) 648 report <- foldM writeWallet [] (files isMutableWallet)
647 return $ KikiSuccess report 649 return $ KikiSuccess report
648 650
651writeRingKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)])
652writeRingKeys krd db wk = do
653 let ks = Map.elems db
654 fs = Map.keys (foldr unionfiles Map.empty ks)
655 where unionfiles (KeyData p _ _ _) m =
656 Map.union m (locations p)
657 fromfile f (KeyData p _ _ _) = Map.member f $ locations p
658 let s = do
659 f <- fs
660 let x = do
661 d@(KeyData p _ _ _) <- filter (fromfile f) (sortByHint f keyMappedPacket ks)
662 n <- maybeToList $ Map.lookup f (locations p)
663 flattenTop f (originallyPublic n) d
664 changes = filter isnew x
665 where isnew p = isNothing (Map.lookup f $ locations p)
666 {-
667 trace (unlines $ ( (f ++ ":") : map (showPacket . packet) x) ++
668 ( "CHANGES: " : map ((" "++) . showPacket . packet) changes)) $ do
669 -}
670 return (f,(changes,x))
671 todo -- porting from kiki.hs writeOutKeyrings
672 return $ KikiSuccess []
673
674
649runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a) 675runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a)
650runKeyRing keyring op = do 676runKeyRing keyring op = do
651 homedir <- getHomeDir (homeSpec keyring) 677 homedir <- getHomeDir (homeSpec keyring)
@@ -679,8 +705,8 @@ runKeyRing keyring op = do
679 } 705 }
680 r <- writeWalletKeys keyring db wk 706 r <- writeWalletKeys keyring db wk
681 try' r $ \report2 -> do 707 try' r $ \report2 -> do
682 report3 <- todo -- write files 708 r <- writeRingKeys keyring db wk
683 709 try' r $ \report3 -> do
684 return $ KikiResult (KikiSuccess a) (report1 ++ report3) 710 return $ KikiResult (KikiSuccess a) (report1 ++ report3)
685 Left err -> return $ KikiResult err [] 711 Left err -> return $ KikiResult err []
686 712
@@ -1239,6 +1265,19 @@ sortByHint fname f = sortBy (comparing gethint)
1239 gethint = maybe defnum originalNum . Map.lookup fname . locations . f 1265 gethint = maybe defnum originalNum . Map.lookup fname . locations . f
1240 defnum = -1 1266 defnum = -1
1241 1267
1268flattenTop :: FilePath -> Bool -> KeyData -> [MappedPacket]
1269flattenTop fname ispub (KeyData key sigs uids subkeys) =
1270 unk ispub key :
1271 ( flattenAllUids fname ispub uids
1272 ++ concatSort fname head (flattenSub fname ispub) (Map.elems subkeys))
1273
1274flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket]
1275flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs
1276
1277unk :: Bool -> MappedPacket -> MappedPacket
1278unk isPublic = if isPublic then toPacket secretToPublic else id
1279 where toPacket f mp@(MappedPacket {packet=p}) = mp {packet=(f p)}
1280
1242flattenAllUids :: FilePath -> Bool -> Map.Map String ([SigAndTrust],OriginMap) -> [MappedPacket] 1281flattenAllUids :: FilePath -> Bool -> Map.Map String ([SigAndTrust],OriginMap) -> [MappedPacket]
1243flattenAllUids fname ispub uids = 1282flattenAllUids fname ispub uids =
1244 concatSort fname head (flattenUid fname ispub) (Map.assocs uids) 1283 concatSort fname head (flattenUid fname ispub) (Map.assocs uids)
diff --git a/kiki.hs b/kiki.hs
index 4daff67..41e6e6b 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -766,19 +766,6 @@ flattenKeys isPublic db = Message $ concatMap (map packet . flattenTop "" isPubl
766 isSecret _ = False 766 isSecret _ = False
767 767
768 768
769flattenTop :: FilePath -> Bool -> KeyData -> [MappedPacket]
770flattenTop fname ispub (KeyData key sigs uids subkeys) =
771 unk ispub key :
772 ( flattenAllUids fname ispub uids
773 ++ concatSort fname head (flattenSub fname ispub) (Map.elems subkeys))
774
775flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket]
776flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs
777
778unk :: Bool -> MappedPacket -> MappedPacket
779unk isPublic = if isPublic then toPacket secretToPublic else id
780 where toPacket f mp@(MappedPacket {packet=p}) = mp {packet=(f p)}
781
782ifSecret (SecretKeyPacket {}) t f = t 769ifSecret (SecretKeyPacket {}) t f = t
783ifSecret _ t f = f 770ifSecret _ t f = f
784 771
@@ -791,8 +778,6 @@ showPacket p | isKey p = (if is_subkey p
791 | otherwise = showPacket0 p 778 | otherwise = showPacket0 p
792showPacket0 p = concat . take 1 $ words (show p) 779showPacket0 p = concat . take 1 $ words (show p)
793 780
794keyMappedPacket (KeyData k _ _ _) = k
795
796writeOutKeyrings :: Map.Map FilePath t -> KeyDB -> IO () 781writeOutKeyrings :: Map.Map FilePath t -> KeyDB -> IO ()
797writeOutKeyrings lkmap db = do 782writeOutKeyrings lkmap db = do
798 let ks = Map.elems db 783 let ks = Map.elems db