diff options
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 45 |
1 files changed, 42 insertions, 3 deletions
@@ -202,6 +202,9 @@ data KikiResult a = KikiResult | |||
202 | 202 | ||
203 | keyPacket (KeyData k _ _ _) = packet k | 203 | keyPacket (KeyData k _ _ _) = packet k |
204 | 204 | ||
205 | keyMappedPacket (KeyData k _ _ _) = k | ||
206 | |||
207 | |||
205 | usage (NotationDataPacket | 208 | usage (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 | |||
622 | writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)]) | 624 | writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)]) |
623 | writeWalletKeys krd db wk = do | 625 | writeWalletKeys 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 | ||
651 | writeRingKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)]) | ||
652 | writeRingKeys 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 | |||
649 | runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a) | 675 | runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a) |
650 | runKeyRing keyring op = do | 676 | runKeyRing 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 | ||
1268 | flattenTop :: FilePath -> Bool -> KeyData -> [MappedPacket] | ||
1269 | flattenTop 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 | |||
1274 | flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket] | ||
1275 | flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs | ||
1276 | |||
1277 | unk :: Bool -> MappedPacket -> MappedPacket | ||
1278 | unk isPublic = if isPublic then toPacket secretToPublic else id | ||
1279 | where toPacket f mp@(MappedPacket {packet=p}) = mp {packet=(f p)} | ||
1280 | |||
1242 | flattenAllUids :: FilePath -> Bool -> Map.Map String ([SigAndTrust],OriginMap) -> [MappedPacket] | 1281 | flattenAllUids :: FilePath -> Bool -> Map.Map String ([SigAndTrust],OriginMap) -> [MappedPacket] |
1243 | flattenAllUids fname ispub uids = | 1282 | flattenAllUids fname ispub uids = |
1244 | concatSort fname head (flattenUid fname ispub) (Map.assocs uids) | 1283 | concatSort fname head (flattenUid fname ispub) (Map.assocs uids) |