From 1435653a92cf5db9e861dafc430b7f0d2b64e51a Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 15 Apr 2014 14:58:27 -0400 Subject: work in progress: writeRingKeys --- KeyRing.hs | 45 ++++++++++++++++++++++++++++++++++++++++++--- kiki.hs | 15 --------------- 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 keyPacket (KeyData k _ _ _) = packet k +keyMappedPacket (KeyData k _ _ _) = k + + usage (NotationDataPacket { human_readable = True , notation_name = "usage@" @@ -618,7 +621,6 @@ walletImportFormat idbyte k = secret_base58_foo (_,bigendian) = S.splitAt 2 (S.concat $ L.toChunks $ encode d) seckey = S.cons idbyte bigendian - writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)]) writeWalletKeys krd db wk = do let cs = db `coinKeysOwnedBy` wk @@ -646,6 +648,30 @@ writeWalletKeys krd db wk = do report <- foldM writeWallet [] (files isMutableWallet) return $ KikiSuccess report +writeRingKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)]) +writeRingKeys krd db wk = do + let ks = Map.elems db + fs = Map.keys (foldr unionfiles Map.empty ks) + where unionfiles (KeyData p _ _ _) m = + Map.union m (locations p) + fromfile f (KeyData p _ _ _) = Map.member f $ locations p + let s = do + f <- fs + let x = do + d@(KeyData p _ _ _) <- filter (fromfile f) (sortByHint f keyMappedPacket ks) + n <- maybeToList $ Map.lookup f (locations p) + flattenTop f (originallyPublic n) d + changes = filter isnew x + where isnew p = isNothing (Map.lookup f $ locations p) + {- + trace (unlines $ ( (f ++ ":") : map (showPacket . packet) x) ++ + ( "CHANGES: " : map ((" "++) . showPacket . packet) changes)) $ do + -} + return (f,(changes,x)) + todo -- porting from kiki.hs writeOutKeyrings + return $ KikiSuccess [] + + runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a) runKeyRing keyring op = do homedir <- getHomeDir (homeSpec keyring) @@ -679,8 +705,8 @@ runKeyRing keyring op = do } r <- writeWalletKeys keyring db wk try' r $ \report2 -> do - report3 <- todo -- write files - + r <- writeRingKeys keyring db wk + try' r $ \report3 -> do return $ KikiResult (KikiSuccess a) (report1 ++ report3) Left err -> return $ KikiResult err [] @@ -1239,6 +1265,19 @@ sortByHint fname f = sortBy (comparing gethint) gethint = maybe defnum originalNum . Map.lookup fname . locations . f defnum = -1 +flattenTop :: FilePath -> Bool -> KeyData -> [MappedPacket] +flattenTop fname ispub (KeyData key sigs uids subkeys) = + unk ispub key : + ( flattenAllUids fname ispub uids + ++ concatSort fname head (flattenSub fname ispub) (Map.elems subkeys)) + +flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket] +flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs + +unk :: Bool -> MappedPacket -> MappedPacket +unk isPublic = if isPublic then toPacket secretToPublic else id + where toPacket f mp@(MappedPacket {packet=p}) = mp {packet=(f p)} + flattenAllUids :: FilePath -> Bool -> Map.Map String ([SigAndTrust],OriginMap) -> [MappedPacket] flattenAllUids fname ispub uids = 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 isSecret _ = False -flattenTop :: FilePath -> Bool -> KeyData -> [MappedPacket] -flattenTop fname ispub (KeyData key sigs uids subkeys) = - unk ispub key : - ( flattenAllUids fname ispub uids - ++ concatSort fname head (flattenSub fname ispub) (Map.elems subkeys)) - -flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket] -flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs - -unk :: Bool -> MappedPacket -> MappedPacket -unk isPublic = if isPublic then toPacket secretToPublic else id - where toPacket f mp@(MappedPacket {packet=p}) = mp {packet=(f p)} - ifSecret (SecretKeyPacket {}) t f = t ifSecret _ t f = f @@ -791,8 +778,6 @@ showPacket p | isKey p = (if is_subkey p | otherwise = showPacket0 p showPacket0 p = concat . take 1 $ words (show p) -keyMappedPacket (KeyData k _ _ _) = k - writeOutKeyrings :: Map.Map FilePath t -> KeyDB -> IO () writeOutKeyrings lkmap db = do let ks = Map.elems db -- cgit v1.2.3