work in progress: writeWalletKeys

1 files changed, 37 insertions, 10 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index d931302..2d92c7e 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -424,7 +424,7 @@ data KeySpec =
 
 
 buildKeyDB :: FilePath -> FilePath -> Maybe String -> KeyRingData
-              -> IO (KikiCondition ((KeyDB,Maybe String),[(FilePath,KikiReportAction)]))
+              -> IO (KikiCondition ((KeyDB,Maybe String,Maybe Packet),[(FilePath,KikiReportAction)]))
 buildKeyDB secring pubring grip0 keyring = do
     let isring (KeyRingFile {}) = True
         isring _                = False
@@ -448,15 +448,15 @@ buildKeyDB secring pubring grip0 keyring = do
                       where isSecringKey (fn,Message ps)
                                 | fn==secring = listToMaybe ps
                             isSecringKey _  = Nothing
+        db_rings = foldl' (uncurry . merge) Map.empty ms
         wk = listToMaybe $ do
                 fp <- maybeToList grip
-                elm <- Map.toList db0
+                elm <- Map.toList db_rings
                 guard $ matchSpec (KeyGrip fp) elm
                 return $ keyPacket (snd elm)
-        db0 = foldl' (uncurry . merge) Map.empty ms
 
     wms <- mapM (readw wk) (files iswallet)
-    let wms' = do
+    let wallet_keys = do
             maybeToList wk
             (fname,xs) <- wms
             (_,sub,(_,m)) <- xs
@@ -476,9 +476,9 @@ buildKeyDB secring pubring grip0 keyring = do
             try r $ \(db'',report) -> do
             return $ KikiSuccess (db'', report0 ++ report)
 
-    db <- foldM importWalletKey (KikiSuccess (db0,[])) wms'
+    db <- foldM importWalletKey (KikiSuccess (db_rings,[])) wallet_keys
     try db $ \(db,report) -> do
-    return $ KikiSuccess ( (db, grip), report )
+    return $ KikiSuccess ( (db, grip, wk), report )
 
 torhash key = maybe "" id $ derToBase32 <$> derRSA key
 
@@ -582,7 +582,32 @@ doImportG doDecrypt db m0 tag fname key = do
                                                  , report )
         Just (False,sig) -> doInsert (Just sig) db -- We have a sig, but is missing usage@ tag
 
-
+isCryptoCoinKey p =
+    and [ isKey p
+        , key_algorithm p == ECDSA
+        , lookup 'c' (key p) == Just (MPI secp256k1_id)
+        ]
+
+getCryptoCoinTag p | isSignaturePacket p = do
+    -- CryptoCoins.secret
+    let sps = hashed_subpackets p ++ unhashed_subpackets p
+    u <- listToMaybe $ mapMaybe usage sps
+    CryptoCoins.lookupNetwork CryptoCoins.network_name u
+getCryptoCoinTag _ = Nothing
+
+
+writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)])
+writeWalletKeys krd db wk = do
+    let all_crypto_keys = do
+            wk <- maybeToList wk
+            let kk = keykey wk
+            KeyData top topsigs uids subs <- maybeToList $ Map.lookup kk db
+            (subkk,SubKey mp sigs) <- Map.toList subs
+            let sub = packet mp
+            guard $ isCryptoCoinKey sub
+            tag <- take 1 $ mapMaybe getCryptoCoinTag (map (packet . fst) sigs)
+            return (tag,mp)
+    return $ KikiSuccess []
 
 runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a)
 runKeyRing keyring op = do
@@ -606,7 +631,7 @@ runKeyRing keyring op = do
     ret <- case functorToEither ret of
       Right {} -> do
          bresult <- buildKeyDB secring pubring grip0 keyring -- build db
-         try' bresult $ \((db,grip),report1) -> do
+         try' bresult $ \((db,grip,wk),report1) -> do
              a <- return $ op KeyRingRuntime
                             { rtPubring = pubring
                             , rtSecring = secring
@@ -615,9 +640,11 @@ runKeyRing keyring op = do
                             , rtGrip = grip
                             , rtKeyDB = db
                             }
-             report2 <- todo -- write files
+             r <- writeWalletKeys keyring db wk
+             try' r $ \report2 -> do
+             report3 <- todo -- write files
             
-             return $ KikiResult (KikiSuccess a) (report1 ++ report2)
+             return $ KikiResult (KikiSuccess a) (report1 ++ report3)
       Left err -> return $ KikiResult err []
 
     forM_ lked $ \(Just lk, fname) -> do dotlock_release lk