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