work in progress: writeRingKeys

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
 
 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)